home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mplbas.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1989-09-27  |  148KB  |  4,113 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 07-30-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  ACHKMAC     1320   Check/execute macro
  19. '  ANSWERIT     200   Answer the telephone when it rings
  20. '  ASCCODES     129   Allow a CONFIG string to have any ASCII value
  21. '  BADCHAR      455   Check user name for invalid characters
  22. '  BADNAME    20235   Check for system crash attempt with bad file name
  23. '  BAUD450     5507   Allow 300 baud callers to bump up to 450 baud
  24. '  CHECKRATIO 20096   Test upload/download ratio
  25. '  CHKMACRO    1242   Checks for macro and processes
  26. '  COPYWRIT      97   Display RBBS-PC's copyright notice
  27. '  DEFALTU     9600   Write out the user's defaults
  28. '  DENYACCESS  1386   Downgrade security so access denied
  29. '  DOOREXIT   10983   Set up a .BAT file to exit RBBS-PC to a "door"
  30. '  DOSEXIT    10934   Set up a .BAT file to exit to DOS (second level)
  31. '  EDITALINE   2618   Edits a single line
  32. '  EDITDEF            Edit configuration parameters
  33. '  FSECCHK    20240   Matches file name to a prefix & extension
  34. '  GETARC     20140   Handle request for verbose listing
  35. '  GETCOMND     101   Get RBBS-PC's node id from command line
  36. '  GETIME      9140   Calculates callers elapsed time (hours, minutes, seconds)
  37. '  GOIDLE        90   Release resources when waiting for keyboard input
  38. '  KILLMSG     3952   Delete old or unnecessary messages
  39. '  LINE25       945   Build and/or update line 25 of RBBS-PC's local screen
  40. '  LINEEDIT    3700   Edit a line while minimizing string space consumption
  41. '  LOGERROR   13660   Log error message to CALLERS file
  42. '  LPRNT       1480   Subroutine to write to local display
  43. '  MLINIT         8   Handle MultiLink initialization/de-initialization
  44. '  MSGPROT     2055   Sets protection for a message
  45. '  MSGTO       2018   Sets who a message is to
  46. '  PAGLEN      5200   Change page length
  47. '  PARSEIT     1637   Parses a string
  48. '  PASSWRD      660   Verify user & message passwords
  49. '  PSCRN       1483   Print to display
  50. '  QLPRNT      1482   Quickly writes count of blocks on file transfer
  51. '  QTPUT       1478   Fast, but limited, "TPUT" equivalent
  52. '  RBBSEXIT   10992   Common RBBS-PC exit to transfer control to other programs
  53. '  RECOVMSG   10410   Recover a deleted message
  54. '  REMNONALF   5100   Removes non-alpha characters from a string
  55. '  RINGCALLER  1636   Ring caller's bell and put message in emphasis
  56. '  SETBAUD     1654   Set baud rate in the 8250 chip of the RS232 interface
  57. '  SETCRLF     1496   Set up the necessary carriage return/line feed string
  58. '  SETSECT    12000   Set the proper section prompts (main, file, util, libr)
  59. '  SETTHREAD   4554   Set up request for threading thru messages
  60. '  SKIPLINE    1485   Write a # of blank lines to the communications port
  61. '  SRCHCMND    1238   Searches list of commands in RBBS for a request
  62. '  SVIOLATION  1380   Process a security violation
  63. '  SYSMENU      112   Displays sysop menu/status
  64. '  SYSOPCHAT   4773   Sysop and caller chat
  65. '  TESTREL      336   Tests for Reliable connect
  66. '  TGET        1498   Read a line from the communications port
  67. '  TPUT        1396   Write a line to the communications port
  68. '  TRIM         105   Strip leading and trailing blanks from a string
  69. '  TRIMTRAIL    107   Strip off specified string off end of another string
  70. '  UNTILRIGHT 12878   Ask a question until user says answer is right
  71. '  UPDATEU    10600   Updates the user record on loging off/exiting RBBS-PC
  72. '  VARINIT      109   Initialize system variables
  73. '  VIEWHELP    1330   Processes help command
  74. '  WHOCHECK    2250   Checks whether a user exists in user file
  75. '  WHOSON      9801   Report status of each node - who's on
  76. '  WORDINFILE 10976   Find a whole word within a file/menu
  77. '
  78. '  $INCLUDE: 'RBBS-VAR.BAS'
  79. '
  80. 8 '  $SUBTITLE: 'MLINIT - MultiLink initialization/deinitialization'
  81. '  $PAGE
  82. '
  83. '  NAME    -- MLINIT
  84. '
  85. '  INPUTS  --  MLPARM = 1             INITIALIZE AT STARTUP OR RE-
  86. '                                     CYLCE TIME
  87. '              MLPARM = 2             DE-INITIALIZE ON EXITING TO
  88. '                                     A DOOR OR DOS REMOTELY
  89. '              MLPARM = 3             DE-QUEUE COMMUNICATIONS PORTS
  90. '              MLPARM = 4             CHECK FOR MULTILINK PRESENT
  91. '              DOORS.TERMINAL.TYPE
  92. '              BAUD.TEST
  93. '              COM.PORT$
  94. '              COMPUTER.TYPE
  95. '
  96. '  OUTPUTS --  NONE
  97. '
  98. '  PURPOSE --  To test for the presence of multi-link and set
  99. '              multi link options to be compatible with RBBS-PC
  100. '
  101.       SUB MLINIT (MLPARM) STATIC
  102.     DEF SEG = 0
  103.     IF COMPUTER.TYPE = 1 _
  104.        GOTO 10
  105.     IF NOT MLCOM THEN _
  106.        IF NETWORK.TYPE <> 1 THEN _
  107.           GOTO 10
  108.     MULTI.LINK.PRESENT = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  109.     IF MULTI.LINK.PRESENT = 0 THEN _
  110.        GOTO 10
  111.     ON MLPARM GOSUB 30,20,60,10
  112. 10  DEF SEG
  113.     EXIT SUB
  114. 20  IF DOORS.TERMINAL.TYPE < 1 THEN _
  115.        RETURN
  116.     DEF SEG = MULTI.LINK.PRESENT
  117.     GOSUB 60
  118. ' **************     MLUTIL BAUD n (where n = BAUD.TEST)  ******
  119.     AX = &H600
  120.     BX = BAUD.TEST!   ' Tell ML the baud rate                        ' KG090102
  121.     GOSUB 80
  122. ' **************     MLUTIL TERM n (where n = DOORS.TERMINAL.TYPE) ****
  123.     AX = &H700 + DOORS.TERMINAL.TYPE
  124.     GOSUB 80         ' Tell ML the terminal type
  125. ' *********          MLINK /port       ***********
  126. '                    ' Tell ML the communications port
  127.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(COM.PORT$,1)) - 48
  128. ' ************       MLUTIL SCMON       *************
  129.     AX = &HB01
  130.     BX = 0           ' Tell ML to start monitoring the carrier
  131.     GOSUB 80
  132.     RETURN
  133. ' **************     MLUTIL CCMON       ***************
  134. 30  AX = &HB00       ' Turn off ML's carrier monitoring.
  135.     BX = 0
  136.     GOSUB 80
  137. ' **************     MLUTIL TERM 1       *************
  138.     AX = &H701       ' Change terminal type to ML type 1.
  139.     BX = 0
  140.     GOSUB 80
  141. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  ******
  142. ' *******            port = 0 if ML 4.00 or greater           ******
  143.     DEF SEG = MULTI.LINK.PRESENT
  144.     MULTI.LINK.COM.PORT = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  145.     MULTI.LINK.VERSION = PEEK(&H1) + 256 * PEEK(&H2)
  146.     IF PEEK(MULTI.LINK.COM.PORT) = &H1 OR _
  147.        PEEK(MULTI.LINK.COM.PORT) = &H2 THEN _
  148.        IF MULTI.LINK.VERSION > 5000 THEN _
  149.           POKE (MULTI.LINK.COM.PORT),&H0 _
  150.        ELSE POKE (MULTI.LINK.COM.PORT),&H9
  151. ' **********         MLUTIL ENQ         **********
  152.     AX = &H1        ' Tell ML to conditional enque on the comm. port
  153.     GOSUB 70
  154. ' **********         MLUTIL BAUD 19200      *********
  155.     AX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  156.     BX = 19200
  157.     GOSUB 80
  158.     RETURN
  159. ' **********         MLUTIL DEQ         *********
  160. 60 AX = &H100        ' Tell ML to unconditionally deque the comm. port
  161. 70 BX = -4
  162.    IF COM.PORT$ = "COM2" THEN _
  163.       BX = -3
  164.    IF COM.PORT$ = "COM0" THEN _
  165.       RETURN
  166. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  *******
  167. 80 CALL RBBSML(AX,BX)
  168.    RETURN
  169.    END SUB
  170. 90 '  $SUBTITLE: 'GOIDLE - release control when waiting'
  171. '  $PAGE
  172. '
  173. '  NAME    -- GOIDLE
  174. '
  175. '  INPUTS  -- MLCOM
  176. '             NETWORK.TYPE
  177. '
  178. '  OUTPUTS --  NONE
  179. '
  180. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  181. '              input from the communications port
  182. '
  183.       SUB GOIDLE STATIC
  184.    IF MLCOM OR NETWORK.TYPE = 1 THEN _
  185.       CALL MLINIT(5) : _
  186.       EXIT SUB
  187.    CALL GIVEBACK
  188.    END SUB
  189. 97 '  $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright'
  190. '  $PAGE
  191. '
  192. '  NAME    -- COPYWRIT
  193. '
  194. '  INPUTS  --  NONE
  195. '
  196. '  OUTPUTS --  NONE
  197. '
  198. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  199. '
  200.       SUB COPYWRIT STATIC
  201.    A = (RECYCLE.TO.DOS OR DEBUG OR NODE.RECORD.INDEX > 2)
  202.    IF A THEN _
  203.       EXIT SUB
  204.    WIDTH 80
  205.    REDIM A$(11)
  206.    A$(1) = "If you use RBBS-PC CPC17.2A, please consider contributing to"
  207.    A$(2) = ""
  208.    A$(3) = "             Capital PC Software Exchange"
  209.    A$(4) = "                 Post Office Box 6128"
  210.    A$(5) = "            Silver Spring, Maryland  20906"
  211.    A$(6) = ""
  212.    A$(7) = "You are free to copy and share RBBS-PC CPC17.2A provided"
  213.    A$(08)= "  1.  This program is distributed unmodified"
  214.    A$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  215.    A$(10)= "  3.  This notice is not bypassed or removed."
  216.    CLS
  217.    KEY OFF
  218.    LOCATE ,,0
  219.    SNOOP = -1
  220.    LOCAL.USER = -1
  221.    CALL LPRNT(SPACE$(60) + "tm",1)
  222.    CALL LPRNT(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  223.    CALL SKIPLINE(1)
  224.    CALL LPRNT(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  225.    CALL SKIPLINE (1)
  226.    CALL LPRNT(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  227.    FOR I = 1 TO 10
  228.       CALL LPRNT(SPACE$(5) + CHR$(186) + "    " + A$(I) + SPACE$(62 - LEN(A$(I))) + CHR$(186),1)
  229.    NEXT
  230.    CALL LPRNT(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  231.    CALL LPRNT(SPACE$(5) + "Copyright (c) 1983-88 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  232.    SNOOP = 0
  233.    END SUB
  234. 101 ' $SUBTITLE: 'GETCOMND - sub to get command from command line'
  235. ' $PAGE
  236. '
  237. '  NAME    -- GETCOMND
  238. '
  239. '  INPUTS  --     PARAMETER                    MEANING
  240. '             CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE TO
  241. '                                  USE AS A MODEL WHEN CREATING THE
  242. '                                  .DEF FILE NAME TO BE USED BY THIS
  243. '                                  COPY OF RBBS-PC.
  244. '
  245. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  246. '                                  RBBS-PC IN THE FORM:
  247. '
  248. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  249. '
  250. '   WHERE THE OPTIONAL PARAMETERS ARE:
  251. '
  252. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  253. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  254. ' DEBUG    IS A DEBUGGING SWITCH
  255. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  256. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  257. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  258. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  259. '             PROGRAM
  260. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  261. '
  262. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  263. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  264. '
  265. '  OUTPUTS -- CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE FOR
  266. '                                  THIS COPY OF RBBS-PC TO USE
  267. '             NODE.RECORD.INDEX    RECORD NUMBER WITHIN THE
  268. '                                  MESSAGES FILE FOR THIS "NODE"
  269. '                                  (RANGE IS 2 TO 36)
  270. '
  271. '  PURPOSE --  To get node id from command line and determine if rbbs
  272. '              is being run as a door
  273. '
  274.       SUB GETCOMND (PASSED.DEBUG,NETIME$,NETBAUD$,NETRELIABLE$) STATIC
  275.       STATIC DEBUG
  276. '
  277. '
  278. ' *  GET NODE ID FROM COMMAND LINE
  279. '
  280. '
  281.       PM$ = COMMAND$
  282.       CALL ALLCAPS(PM$)
  283.       IF INSTR(PM$,"/") = 0 THEN _
  284.          GOTO 103
  285. '
  286. '
  287. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  288. '
  289. '
  290.       CMD.LINE$ = MID$(PM$,INSTR(PM$,"/"))
  291.       PM$ = LEFT$(PM$,INSTR(PM$,"/") - 1)
  292.       A = 0
  293.       FOR X = 1 TO LEN(CMD.LINE$)
  294.           IF MID$(CMD.LINE$,X,1) = "/" THEN _
  295.              A = A + 1 : _
  296.              SUBDIR$(A) = "" _                                       ' KGO81203
  297.           ELSE SUBDIR$(A) = SUBDIR$(A) + MID$(CMD.LINE$,X,1)         ' KG081203
  298.       NEXT
  299.       NETIME$ = SUBDIR$(1)                                           ' KG081203
  300.       IF A > 1 THEN _
  301.          NETBAUD$ = SUBDIR$(2)                                       ' KG081203
  302.       IF A > 2 THEN _
  303.          NETRELIABLE$ = SUBDIR$(3)                                   ' KG081203
  304.       CALL TRIM(NETIME$)
  305.       CALL TRIM(NETBAUD$)
  306.       CALL TRIM(NETRELIABLE$)
  307. 103   A = INSTR(PM$,"DEBUG")
  308.       IF A > 0 THEN _
  309.          DEBUG = -1 : _
  310.          PM$ = LEFT$(PM$,A - 1) + _
  311.                RIGHT$(PM$,LEN(PM$) - A - 4)
  312.       PASSED.DEBUG = DEBUG
  313.       A = INSTR(PM$,"LOCAL")
  314.       IF A > 0 THEN _
  315.          COM.PORT$ = "COM0" : _
  316.          PM$ = LEFT$(PM$,A - 1) + _
  317.                RIGHT$(PM$,LEN(PM$) - A - 4)
  318.       IF LEN(PM$) = 0 THEN _
  319.          PM$ = "-"
  320.       NODE.RECORD.INDEX = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(PM$,1))
  321.       IF NODE.RECORD.INDEX < 2 THEN _
  322.          NODE.RECORD.INDEX = 2
  323.       NODE.ID$ = MID$(STR$(NODE.RECORD.INDEX-1),2)
  324.       IF NODE.RECORD.INDEX > 10 THEN _
  325.          NODE.FILE.ID$ = LEFT$(PM$,1) _
  326.       ELSE NODE.FILE.ID$ = NODE.ID$
  327.       IF NODE.ID$ <> "1" THEN _
  328.          LIBRARY.NODE.ID$ = NODE.FILE.ID$
  329.       IF LEN(PM$) > 2 AND MID$(PM$,2,1) = " " THEN _
  330.          CONFIG.FILENAME$ = MID$(PM$,3)_
  331.       ELSE MID$(CONFIG.FILENAME$,5,1) = PM$
  332.       ORIG.CONFIG$ = CONFIG.FILENAME$
  333.       END SUB
  334. 105 ' $SUBTITLE: 'TRIM - sub to eliminate leading/trailing blanks'
  335. ' $PAGE
  336. '
  337. '  NAME    -- TRIM
  338. '
  339. '  INPUTS  --  PARAMETER                    MEANING
  340. '              TRIM.PARM$           STRING THAT IS TO HAVE LEADING
  341. '                                   AND TRAILING BLANKS ELIMINATED FROM
  342. '
  343. '  OUTPUTS --  TRIM.PARM$           STRING WITH NO LEADING OR TRAILING
  344. '                                   BLANKS
  345. '
  346. '  PURPOSE --  To strip leading and trailing blanks
  347. '
  348.       SUB TRIM (TRIM.PARM$) STATIC
  349.       L = INSTR(TRIM.PARM$," ")
  350.       IF L < 1 THEN _
  351.          EXIT SUB
  352.       IF L = 1 THEN _
  353.          WHILE LEFT$(TRIM.PARM$,1) = " " : _
  354.             TRIM.PARM$ = RIGHT$(TRIM.PARM$,LEN(TRIM.PARM$) - 1) : _
  355.          WEND
  356.       CALL TRIMTRAIL (TRIM.PARM$," ")
  357.       END SUB
  358. '
  359. 107 '  $SUBTITLE: 'TRIMTRAIL - sub to trim off trailing characters'
  360. '  $PAGE
  361. '
  362. '  NAME    --  TRIMTRAIL
  363. '
  364. '  INPUTS  --  PARAMETER           MEANING
  365. '              TRIM.PARM$  WHAT STRING TO TRIM FROM                  ' KG081003
  366. '              TRIM.THIS$  WHAT CHARACTER TO TRIM OFF END
  367. '
  368. '  OUTPUTS --  NONE
  369. '
  370. '  PURPOSE --  To remove all occurences of a character from end of string ' KG081003 
  371. '
  372.       SUB TRIMTRAIL (TRIM.PARM$,TRIM.THIS$) STATIC
  373.       IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN _                  ' KG081003
  374.          EXIT SUB                                                    ' KG081003
  375.       J = LEN(TRIM.PARM$) - 1                                        ' KG081003
  376. 108   IF J > 0 THEN _                                                ' KG081003
  377.          IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN _               ' KG081003
  378.             J = J - 1 : _                                            ' KG081003
  379.             GOTO 108                                                 ' KG081003
  380.       TRIM.PARM$ = LEFT$(TRIM.PARM$, J)                              ' KG081003
  381.       END SUB
  382. '
  383. 109 '  $SUBTITLE: 'VARINIT - subroutine to initialize system variables'
  384. '  $PAGE
  385. '
  386. '  NAME    --  VARINIT
  387. '
  388. '  INPUTS  --  PARAMETER           MEANING
  389. '              NONE
  390. '
  391. '  OUTPUTS --  NONE
  392. '
  393. '  PURPOSE --  To initialize system variable
  394. '
  395.       SUB VARINIT STATIC
  396.     ACKNOWLEDGE$ = CHR$(6)
  397.     ACKC$ = "C" + _
  398.             ACKNOWLEDGE$
  399.     ACTIVE.MENU$ = "B"
  400.     ACTIVE.MESSAGE$ = CHR$(225)
  401.     BACKSPACE$ = CHR$(8) + _
  402.                  CHR$(32) + _
  403.                  CHR$(8)
  404.     BACK.ARROW$ = CHR$(29) + _
  405.                   CHR$(32) + _
  406.                   CHR$(29)
  407.     BELL.RINGER$ = CHR$(7)
  408.     BULLETIN.MENU$ = ""
  409.     C.L = 24
  410.     CANCEL$ = CHR$(24)
  411.     COLOR.RESET$ = CHR$(27) + _
  412.                    "[00;37;40m"
  413.     CONFIG.FILENAME$ = "RBBS-PC.DEF"
  414.     CARRIAGE.RETURN$ = CHR$(13)
  415.     DELETED.MESSAGE$ = CHR$(226)
  416.     DOS.VERSION = 2
  417.     END.TRANSMISSION$ = CHR$(4)
  418.     ESCAPE$ = CHR$(27)
  419.     EXPECT.ACTIVE.MODEM = 0
  420.     FALSE = 0
  421.     F1.KEY = 59
  422.     F10.KEY = 68
  423.     GRN$ = "MAIN"
  424.     CALL SETHILITE (TRUE)
  425.     HOME.CONFERENCE$ = ""
  426.     IN.CONF.MENU = -1
  427.     LAST.COMMAND$ = "M "                                             ' KG060701
  428.     LIMIT.MINUTES.PER.SESSION! = 0
  429.     LINE.FEED$ = CHR$(10)
  430.     LINE.FEEDS = NOT FALSE
  431.     LINEEDIT.CHK$ = CHR$(9) + _
  432.                     LINE.FEED$ + _
  433.                     CHR$(11) + _
  434.                     CHR$(12) + _
  435.                     CHR$(127) + _
  436.                     CHR$(8) + _
  437.                     BELL.RINGER$ + _
  438.                     CHR$(26) + _
  439.                     CHR$(227)
  440.     LINEMES$ = SPACE$(78)          ' fixed length string workspace
  441.     LOCK.STATUS$ = "UM UU UB UD"
  442.     MENU.INDEX = 2
  443.     NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  444.     NO.ADVANCE = FALSE
  445.     PAGE.LENGTH = 23
  446.     PARSE.OFF = FALSE
  447.     PRESS.ENTER$ = " (Press [ENTER] to quit)"
  448.     PRESS.ENTER.EXPERT$ = " ([ENTER] quits)"
  449.     PRESS.ENTER.NOVICE$ = PRESS.ENTER$
  450.     PRIVATE.DOOR = FALSE
  451.     RIGHT.MARGIN = 72
  452.     RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + _
  453.                         LINE.FEED$
  454.     SMART.TABLE$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  455.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI"
  456.     START.OF.HEADER$ = CHR$(1)
  457.     TIME.LOGGED.ON$ = SPACE$(8)
  458.     TRUE = NOT FALSE
  459.     UPINC = -1
  460.     XOFF$ = CHR$(19)
  461.     XON$ = CHR$(17)
  462.     INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
  463.     OPTION.END$ = RETURN.LINE.FEED$ + " ,("
  464.     CRLF$ = CARRIAGE.RETURN$ + LINE.FEED$
  465.     LG$(1) = "Registration Check Failed"
  466.     LG$(2) = "Sysop name attempted"
  467.     LG$(3) = "Locked out attempt"
  468.     LG$(4) = "Password Attempt Failed"
  469.     LG$(5) = "Auto Lockout done"
  470.     LG$(6) = "Name in use on another Node!"
  471.     LG$(7) = ""
  472.     LG$(8) = "Locked reason read!"
  473.     LG$(9) = "Expired Registration"
  474.     END SUB
  475. '
  476. 112 ' $SUBTITLE: 'SYSMENU - sub to display RBBS-PC SYSOP menu'
  477. '  $PAGE
  478. '
  479. '  NAME    --  SYSMENU
  480. '
  481. '  INPUTS  --  PARAMETER           MEANING
  482. '                DELAY!    TIME IN SECONDS AFTER MIDNIGHT TO WAIT
  483. '                            BEFORE DISPLAYING
  484. '
  485. '  OUTPUTS --  NONE
  486. '
  487. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  488. '
  489.     SUB SYSMENU STATIC
  490.     DELAY! = 0
  491.     LOCAL.USER = TRUE
  492.     SNOOP = TRUE
  493.     NON.STOP = TRUE
  494.     SUBROUTINE.PARAMETER = 1
  495.     WHILE SUBROUTINE.PARAMETER = 1
  496.        CALL CHECKTIM (DELAY!)
  497.     WEND
  498.     CLS
  499.     STOP.INTERRUPTS = TRUE
  500.     BYPASS.TIME.CHECK = TRUE
  501.     CALL BUFFILE ("MENU0",X)
  502.     NON.STOP = FALSE
  503.     BYPASS.TIME.CHECK = FALSE
  504.     LOCAL.USER = FALSE
  505.     IF NOT OK THEN _
  506.        CALL LPRNT("MENU0 not on default drive",1)
  507.     LOCATE 2,18
  508.     CALL LPRNT(LEFT$(VERSION.ID$,8),0)
  509.     LOCATE 2,42
  510.     CALL LPRNT(NODE.ID$,0)
  511.     LOCATE 2,60
  512.     X$ = DATE$
  513.     CALL LPRNT(LEFT$(X$,6) + RIGHT$(X$,2),0)
  514.     LOCATE 2,74
  515.     CALL LPRNT(LEFT$(TIME$,5),0)
  516.     IF FMS.DIRECTORY$ <> "" THEN _
  517.        LOCATE 6,76 : _
  518.        CALL LPRNT("YES",0)
  519.     IF EXTENDED.LOGGING THEN _
  520.        LOCATE 8,76 : _
  521.        CALL LPRNT("YES",0)
  522.     IF FOSSIL THEN _
  523.        LOCATE 10,76 : _
  524.        CALL LPRNT("YES",0)
  525.     LOCATE 12,75 : _
  526.     CALL LPRNT(COM.PORT$,0)
  527.     LOCATE 14,75
  528.     CALL LPRNT (STR$(CINT(FRE("A")/1024)) + "k",0)
  529.     IF DEBUG THEN _
  530.        LOCATE 22,76 : _
  531.        CALL LPRNT("Yes",0)
  532.     END SUB
  533. '
  534. 120 '  $SUBTITLE: 'EDITDEF - sub to edit config parameters'
  535. '  $PAGE
  536. '
  537. '  NAME    -- EDITDEF
  538. '
  539. '  INPUTS  --     PARAMETER                    MEANING
  540. '
  541. '  OUTPUTS --                          OUTPUT STRING
  542. '
  543. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  544. '
  545.       SUB EDITDEF STATIC
  546.       ALL.OPTS$ = MAIN.COMMANDS$ + _
  547.                   FILE.COMMANDS$ + _
  548.                   UTIL.COMMANDS$ + _
  549.                   LIBRARY.COMMANDS$ + _
  550.                   GLOBAL.COMMANDS$ + _
  551.                   SYSOP.COMMANDS$
  552.       HELP.EXTENSION$ = "." + _
  553.                         HELP.EXTENSION$
  554.       BEG.MAIN = 1
  555.       BEG.FILE = LEN(MAIN.COMMANDS$) + BEG.MAIN
  556.       BEG.UTIL = LEN(FILE.COMMANDS$) + BEG.FILE
  557.       BEG.LIBRARY = LEN(UTIL.COMMANDS$) + BEG.UTIL
  558.       HELP$(3) = HELP.PATH$ + _
  559.                  HELP$(3)
  560.       HELP$(4) = HELP.PATH$ + _
  561.                  HELP$(4)
  562.       HELP$(7) = HELP.PATH$ + _
  563.                  HELP$(7)
  564.       HELP$(9) = HELP.PATH$ + _
  565.                  HELP$(9)
  566.       CALL BRKFNAME (WELCOME.FILE$,WELCOME.FILE.DRV.PATH$,PREFIX$,_
  567.                      EXTENSION$,TRUE)
  568.      CALL ASCCODES ("[","]",DEFAULT.LINE.ACK$)
  569.      CALL ASCCODES ("[","]",HOST.ECHO.ON$)
  570.      CALL ASCCODES ("[","]",HOST.ECHO.OFF$)
  571.      CALL ASCCODES ("[","]",EMPHASIZE.OFF.DEF$)
  572.      CALL ASCCODES ("[","]",EMPHASIZE.ON.DEF$)
  573.      DR.1$ = FG.1.DEF$
  574.      DR.2$ = FG.2.DEF$
  575.      DR.3$ = FG.3.DEF$
  576.      DR.4$ = FG.4.DEF$
  577.      IF SUBROUTINE.PARAMETER = -62 THEN _
  578.         EXIT SUB
  579.      LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")
  580.      IF LOCAL.USER.MODE THEN _
  581.         RECYCLE.TO.DOS = TRUE
  582.      ECHOER$ = DEFAULT.ECHOER$
  583.      IF LEN(SCREEN.OUT.MSG$) < 2 THEN _
  584.         SCREEN.OUT.MSG$ = START.OF.HEADER$
  585.      SMART.TEXT$ = CHR$(SMART.TEXT)
  586.      IF MAX.WORK.VAR < 13 THEN _
  587.         MAX.WORK.VAR = 13
  588. '
  589. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  590. '
  591.     IF MAIN.FMS.DIRECTORY$ <> "" THEN _
  592.        FMS.DIRECTORY$ = DIRECTORY.PATH$ + _
  593.                         MAIN.FMS.DIRECTORY$ + _
  594.                         "." + _
  595.                         MAIN.DIRECTORY.EXTENTION$ : _
  596.        ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$ : _
  597.        LIBRARY.DIRECTORY$ = LIBRARY.DIRECTORY.PATH$ + _
  598.                             MAIN.FMS.DIRECTORY$ + _
  599.                             "." + _
  600.                             LIBRARY.DIRECTORY.EXTENTION$
  601.     UPCAT.HELP$ = HELP.PATH$ + _
  602.                   UPCAT.HELP$ + _
  603.                   HELP.EXTENSION$
  604.     IF SUBDIR.COUNT < 1 THEN _
  605.        GOTO 123
  606.     FOR SUBDIR.INDEX = 1 TO SUBDIR.COUNT
  607.        INPUT #2,SUBDIR$
  608.        IF RIGHT$(SUBDIR$,1) <> "\" THEN _
  609.          SUBDIR$(SUBDIR.INDEX) = SUBDIR$ + _
  610.                                  "\" _
  611.        ELSE SUBDIR$(SUBDIR.INDEX) = SUBDIR$
  612.     NEXT
  613.     GOTO 125
  614. 123 FOR SUBDIR.INDEX = 1 TO LEN(DOWNLOAD.DRIVES$) - 1
  615.        SUBDIR$(SUBDIR.INDEX) = MID$(DOWNLOAD.DRIVES$,SUBDIR.INDEX,1) + _
  616.                                ":"
  617.     NEXT
  618.     SUBDIR.COUNT = LEN(DOWNLOAD.DRIVES$) - 1
  619. '
  620. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ***
  621. '
  622. 125 UPLOAD.DIR.CHECK$ = UPLOAD.DIRECTORY$
  623.     SUBDIR.COUNT = SUBDIR.COUNT + 1
  624.     IF UPLOAD.TO.SUBDIR THEN _
  625.        SUBDIR$(SUBDIR.COUNT) = UPLOAD.SUBDIR$ + _
  626.                                "\" _
  627.     ELSE SUBDIR$(SUBDIR.COUNT) = RIGHT$(DOWNLOAD.DRIVES$,1) + _
  628.                                  ":"
  629.     UPLOAD.DIRECTORY$ = UPLOAD.DIRECTORY$ + _
  630.                         "." + _
  631.                         MAIN.DIRECTORY.EXTENTION$
  632.     CALL CHKNARY (SUBDIR$(SUBDIR.COUNT),SUBDIR$(),SUBDIR.COUNT-1,FOUND)
  633.     CAN.DOWNLOAD.FROM.UP = (FOUND > 0)
  634.     UPLOAD.DIRECTORY$ = UPLOAD.PATH$ + _
  635.                         UPLOAD.DIRECTORY$
  636. 126 CLOSE #2
  637.     IF LIBRARY.DRIVE$ <> "" THEN _
  638.        LIBRARY.TYPE = 1
  639.     SUBROUTINE.PARAMETER = -10
  640.     CALL CARRIER
  641.     IF SUBROUTINE.PARAMETER = -1 THEN _
  642.        IF LIBRARY.DRIVE$ <> "" THEN _
  643.           CALL CHANGEDIR (LIBRARY.DRIVE$ + _
  644.                          "\") : _
  645.           CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  646.                         LIBRARY.NODE.ID$ + _
  647.                         "DK*.ARC") : _
  648.                         EC = 0
  649. '
  650. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  651. '
  652. 128 IF NETWORK.TYPE = 2 THEN _
  653.        CN$ = SPACE$(535) : _
  654.        CALL INITIO(A)
  655.        END SUB
  656. '
  657. 129 '  $SUBTITLE: 'ASCCODES - subrotuine to allow any ASCII codes'
  658. '  $PAGE
  659. '
  660. '  NAME    -- ASCCODES
  661. '
  662. '  INPUTS  --     PARAMETER                    MEANING
  663. '                 LEFT.PAREN$           MARKS BEGINNING OF #
  664. '                 RIGHT.PAREN$          MARKS END OF #
  665. '                 STRNG$                INPUT STRING
  666. '
  667. '  OUTPUTS --    STRNG$                OUTPUT STRING
  668. '
  669. '  PURPOSE -- To allow a config string to have any ascii values.
  670. '             characters not enclosed taken as is.  Enclosed
  671. '             characters interpreted as value of ascii code.
  672. '             (e.g. "123[32]4" is interpreted as "123 4").
  673. '
  674.     SUB ASCCODES (LEFT.PAREN$,RIGHT.PAREN$,STRNG$) STATIC
  675.     IF LEN(STRNG$) < 1 THEN _
  676.        EXIT SUB
  677.     STRT = 1
  678.     L = LEN(STRNG$)
  679.     B$ = STRNG$ + _
  680.          LEFT.PAREN$
  681.     X = INSTR(B$,LEFT.PAREN$)
  682.     NEW.STRNG$ = ""
  683.     WHILE STRT <= L
  684.        NEW.STRNG$ = NEW.STRNG$ + _
  685.                     MID$(B$,STRT,X - STRT)
  686.        Y = INSTR(X,B$,RIGHT.PAREN$)
  687.        IF Y > 0 THEN _
  688.           K = VAL(MID$(B$,X + 1,Y - X - 1)) : _
  689.           NEW.STRNG$ = NEW.STRNG$ + _
  690.                        CHR$(K) : _
  691.           STRT = Y + 1 _
  692.        ELSE NEW.STRNG$ = NEW.STRNG$ + _
  693.                          MID$(B$,X,L + 1 - X) : _
  694.             STRT = L + 1
  695.        X = INSTR(STRT,B$,LEFT.PAREN$)
  696.     WEND
  697.     STRNG$ = NEW.STRNG$
  698.     END SUB
  699. 200 ' $SUBTITLE: 'ANSWERIT - sub to establish connection'
  700. ' $PAGE
  701. '
  702. '  NAME    -- ANSWERIT
  703. '
  704. '  INPUTS  --     PARAMETER                    MEANING
  705. '            SUBROUTINE.PARAMETER = 1   WAIT FOR PHONE TO RING
  706. '                                 = 2   CONTINUE LOOKING FOR CONNECT
  707. '                                 = 3   RENTRY AFTER FUNCTION KEY
  708. '                                 = 4   GO ON LINE IMMEDIATELY
  709. '            BG                         LOCAL DISPLAY'S BACKGROUND
  710. '            BORDER                     LOCAL DISPLAY'S BORDER COLOR
  711. '            COM.PORT$                  COMMUNICATIONS PORT NAME
  712. '            COMPUTER.TYPE              TYPE OF COMPUTER RUNNING ON
  713. '            DUMB.MODEM                 NON-HAYES TYPE MODEM FLAG
  714. '            EXTENDED.LOGGING           EXTENDED CALLERS LOG FLAG
  715. '            FG                         LOCAL DISPLAY'S FOREGROUND
  716. '            MODEM.ANSWER.COMMAND$      COMMAND TO ANSWER PHONE
  717. '            MODEM.CONTROL.REGISTER     LOCATION OF MODEM CNTRL. REG
  718. '            MODEM.COUNT.RINGS.COMMAND$ COMMAND TO COUNT PHONE RINGS
  719. '            MODEM.INIT.BAUD$           BAUDE AT WHICH TO OPEN COMM.
  720. '            MODEM.RESET.COMMAND$       COMMAND TO RESET THE MODEM
  721. '            MODEM.STATUS.REGISTER      LOCATION OF MODEM STATUS REG
  722. '            PRINTER                    FLAG TO PRINT ON LOCAL PRT.
  723. '            REQUIRED.RINGS             NUMBER OF RINGS TO ANSWER ON
  724. '            SNOOP                      FLAG TO DISPLAY ON LOCAL PC
  725. '            SYSOP.NEXT                 FLAG TO GIVE SYSOP CONTROL
  726. '
  727. '  OUTPUTSS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  728. '              EIGHT.BIT                  PARITY INDICATOR
  729. '              RELIABLE.MODE              INDICATES MODEM-SUPPLIED
  730. '                                         "ERROR-FREE" PROTOCOL ACTIVE
  731. '              SUBROUTINE.PARAMETER = 1   CARRIER DETECT FOUND (I.E.
  732. '                                         MODEM AUTO-ANSWERED).
  733. '                                   = 2   ANSWERED THE PHONE AND
  734. '                                         CARRIER DETECT OCCURRED.
  735. '                                   = 3   SYSOP HIT "ESC" KEY ON THE
  736. '                                         LOCAL KEYBOARD.
  737. '                                   = 4   ANSWERED THE PHONE BUT NO
  738. '                                         CARRIER WAS DETECTED.
  739. '                                   = 5   COMM. BUFFER OVERFLOW.
  740. '                                   = 6   FUNCTION KEY PRESSED ON THE
  741. '                                         LOCAL KEYBOARD.
  742. '
  743. '  PURPOSE -- To detect incoming call and establish connection.
  744. '
  745.       SUB ANSWERIT STATIC
  746.       EC = 0
  747.       RELIABLE.MODE = FALSE
  748.       FF = SUBROUTINE.PARAMETER
  749.       SUBROUTINE.PARAMETER = 0
  750.       ON FF GOTO 201,324,245,320
  751. '
  752. '
  753. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS
  754. '
  755. '
  756. 201 SUBROUTINE.PARAMETER = -10
  757.     CALL CARRIER
  758.     IF SUBROUTINE.PARAMETER = 0 THEN _
  759.        GOTO 210                                                      ' KG061103
  760. '
  761. '
  762. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY
  763. '
  764. '
  765.     IF FOSSIL THEN _
  766.        STATE% = 0 : _
  767.        CALL FOSDTR(COMPORT%,STATE%) _
  768.     ELSE OUT MODEM.CONTROL.REGISTER,&H4
  769.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  770. '
  771. '
  772. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT
  773. '
  774. '
  775.     IF FOSSIL THEN _
  776.        STATE% = 1 : _
  777.        CALL FOSDTR(COMPORT%,STATE%) _
  778.     ELSE OUT MODEM.CONTROL.REGISTER,&H0
  779.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  780. 210 IF PRIVATE.DOOR THEN _
  781.        CALL TRANSFER : _
  782.        GOTO 235
  783.     CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  784. 220 CALL AMORPMTD                                                    ' KG061203
  785. 230 IF PRINTER THEN _
  786.        CALL PRINTIT (" RBBS-PC " + VERSION.ID$ + " Node " + _
  787.                     NODE.ID$ + " up " + TIM$ + " on " + DATE$)
  788. 235 EIGHT.BIT = TRUE
  789.     SUBROUTINE.PARAMETER = -10
  790.     CALL CARRIER
  791.     IF SUBROUTINE.PARAMETER = 0 AND _
  792.        EXIT.TO.DOORS THEN _
  793.        CALL READPROF : _
  794.        SUBROUTINE.PARAMETER = 1 : _
  795.        GOTO 335
  796.     IF SUBROUTINE.PARAMETER = 0 AND _
  797.        EXPECT.ACTIVE.MODEM THEN _
  798.        BAUD.TEST! = VAL(NETBAUD$) : _                                ' KG090102
  799.        CALL TESTREL (NETRELIABLE$) : _
  800.        GOTO 328
  801.     IF EXPECT.ACTIVE.MODEM OR _
  802.        EXIT.TO.DOORS THEN _
  803.        SUBROUTINE.PARAMETER = 4 : _
  804.        EXIT SUB
  805.     IF SUBROUTINE.PARAMETER = 0 THEN _
  806.        GOTO 324
  807.     PCJR = FALSE
  808.     IF COMPUTER.TYPE = 2 AND _
  809.        COM.PORT$ = "COM1" AND _
  810.        MODEM.STATUS.REGISTER = 1022 THEN _
  811.        MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + _
  812.                                    "P" : _
  813.        PCJR = TRUE
  814.     CALL SYSMENU
  815.     IF PCJR THEN _
  816.        A$ = CHR$(14) + _
  817.             "I" _
  818.     ELSE A$ = MODEM.RESET.COMMAND$
  819.     CALL MODEMPUT (A$)
  820.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  821.     IF PCJR THEN _
  822.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  823.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  824.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  825.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  826.     ELSE A$ = MODEM.INIT.COMMAND$
  827.     CALL MODEMPUT (A$)
  828.     IF PCJR THEN _
  829.        A$ = CHR$(14) + _
  830.             "F 4" : _
  831.        CALL MODEMPUT (A$)
  832.     RINGBACK = FALSE
  833.     LOCATE 16,55
  834.     IF REQUIRED.RINGS = 0 THEN _
  835.        CALL LPRNT("WAITING FOR CARRIER",0) : _
  836.        GOTO 237
  837.     IF MID$(MODEM.INIT.COMMAND$, _
  838.           INSTR(MODEM.INIT.COMMAND$,"S0") + 3,3) = "255" THEN _
  839.        CALL LPRNT("RING BACK SYSTEM",0) : _
  840.        RINGBACK = TRUE : _
  841.        GOTO 236
  842.     CALL LPRNT(" WAITING FOR RING ",0)                               ' RS060402
  843. 236 LOCATE 16,76 : _
  844.     CALL LPRNT(MID$(STR$(REQUIRED.RINGS),2),0)
  845. 237 LOCATE 18,76
  846.     IF DOSANSI THEN _
  847.        CALL LPRNT(ESCAPE$ + "[05m" + "YES" + ESCAPE$ + "[00m",0) _
  848.     ELSE CALL LPRNT ("YES",0)
  849.     COLOR FG,BG,BORDER
  850.     LOCATE 20,56
  851. '
  852. '
  853. ' *  GET READY TO ANSWER INCOMMING CALL:
  854. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  855. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  856. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  857. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM INIT COMMAND.
  858. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  859. ' *           FIRST CALLS AND THEN HANGS UP (I.E. RING-BACK).
  860. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  861. '
  862. '
  863.     QQ = 255
  864.     I = INSTR(MODEM.INIT.COMMAND$,"S0")
  865.     IF I = 0 OR PCJR THEN _
  866.        GOTO 239
  867.     IF VAL(MID$(MODEM.INIT.COMMAND$,I + 3,3)) = 255 THEN _
  868.        QQ = 0 : _
  869.        BLK = QQ
  870.     CALL FINDTIME (TCA!)
  871.     SUBROUTINE.PARAMETER = 1
  872.     CALL LINE25
  873.     RING.ANSWER = TRUE
  874.     IF RINGBACK THEN _
  875.        RING.ANSWER = FALSE
  876. 239 RINGBACK.WAIT.STARTED! = 0
  877.     IF RINGBACK THEN _
  878.        CALL FINDTIME (RINGBACK.WAIT.STARTED!) : _
  879.        COLOR 7,0,0 _
  880.     ELSE COLOR FG,BG,BORDER
  881. 240 IF SYSOP.NEXT THEN _
  882.        SUBROUTINE.PARAMETER = 3 : _
  883.        EXIT SUB
  884. '
  885. '
  886. ' * WAIT FOR INCOMING CALLS
  887. '
  888. '
  889.     SCREEN.ALREADY.CLEARED = FALSE
  890. 245 CALL SETABORT (INACTIVE.DELAY!, (60 * RECYCLE.WAIT))
  891.     NO.CALL = TRUE
  892.     CALL FLUSHCOM (MODEM.RESPONSE$)
  893.     MODEM.RESPONSE$ = ""
  894. 247 IF INP(MODEM.STATUS.REGISTER) > 127 OR (NOT NO.CALL) THEN _
  895.        GOTO 274
  896.        CALL FINDFUNC
  897.        IF SUBROUTINE.PARAMETER < 0 THEN _
  898.           EXIT SUB
  899. 250    IF KEY.PRESSED$ = ESCAPE$ THEN _
  900.           SUBROUTINE.PARAMETER = 3 : _
  901.           EXIT SUB
  902.        IF KEY.PRESSED$ <> "" THEN _
  903.           GOTO 235
  904. 260    IF RINGBACK.WAIT.STARTED! > 0 THEN _
  905.           CALL FINDTIME (TI!) : _
  906.        IF ABS(TI! - RINGBACK.WAIT.STARTED!) > 45 THEN _
  907.           RINGBACK.WAIT.STARTED! = 0 : _
  908.           RING.BACK.COUNT = 0 : _
  909.           RING.ANSWER = FALSE: _
  910.           IF RINGBACK THEN _
  911.             LOCATE 20,56 : _
  912.             CALL LPRNT("Ringback timeout" + PAGING.PRINTER.SUPPORT$,1)
  913. 265    CALL FINDTIME (TI!)
  914.        IF ABS(TI! - TCA!) > 120 AND NOT SCREEN.ALREADY.CLEARED THEN _
  915.           LOCATE ,,0 : _
  916.           CLS : _
  917.           C.L = 1 : _
  918.           SCREEN.ALREADY.CLEARED = TRUE : _
  919.           CALL FINDTIME (TCA!)
  920.        IF TIME.TO.DROP.TO.DOS! > 0 AND _
  921.           OLD.DAT$ <> DATE$ AND _
  922.           TI! < 86340 AND _        ' Skip btw 23:59 and 00:00
  923.           TI! => TIME.TO.DROP.TO.DOS! THEN _
  924.              SUBROUTINE.PARAMETER = 7 : _
  925.              EXIT SUB
  926. 266    IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 AND _
  927.           REQUIRED.RINGS > 0 THEN _
  928.           GOTO 276
  929. 270    IF RECYCLE.WAIT > 0 THEN _
  930.           IF TI! > INACTIVE.DELAY! THEN _
  931.              SUBROUTINE.PARAMETER = 8 : _
  932.              EXIT SUB
  933.        CALL FLUSHCOM (X$)
  934.        IF LEN(X$) > 0 THEN _
  935.           MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$ : _
  936.           RING.DETECTED = (INSTR(MODEM.RESPONSE$,"RING") > 0) : _
  937.           CONNECT.DETECTED = (INSTR(MODEM.RESPONSE$,"ONNECT") > 0) : _
  938.           NO.CALL = (NOT RING.DETECTED) AND (NOT CONNECT.DETECTED)
  939.     IF RING.DETECTED AND REQUIRED.RINGS > 0 THEN _
  940.        MID$(MODEM.RESPONSE$, INSTR(MODEM.RESPONSE$,"RING")+1,1) = "A" : _
  941.        RING.DETECTED = FALSE : _
  942.        GOTO 276
  943.     CALL GOIDLE
  944.     GOTO 247
  945. 274 IF NOT RINGBACK THEN _
  946.        IF CONNECT.DETECTED THEN _
  947.           GOTO 321
  948.     IF REQUIRED.RINGS = 0 THEN _
  949.        CALL DELAYIT (3) : _
  950.        GOTO 321
  951. '
  952. '
  953. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR
  954. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --
  955. ' * "RING BACK."
  956. '
  957. '
  958. 276 CALL EOFCOMM (CHAR%)
  959.     IF CHAR% <> -1 THEN _
  960.        CALL FLUSHCOM(X$) : _
  961.        IF SUBROUTINE.PARAMETER = - 1 THEN _
  962.           EXIT SUB
  963.     IF PCJR THEN _
  964.        GOTO 320
  965.     A$ = MODEM.COUNT.RINGS.COMMAND$
  966.     CALL MODEMPUT (A$)
  967.     CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  968. 290 CALL FLUSHCOM(X$)
  969.     IF SUBROUTINE.PARAMETER = -1 THEN _
  970.        EXIT SUB
  971. 291 IF LEN(X$) = 0 THEN _
  972.        GOTO 310
  973. 292 IF INSTR(X$,"0") < 1 THEN _
  974.        GOTO 293
  975.     X$ = MID$(X$,INSTR(X$,"0"))
  976. 293 IF (NOT RING.ANSWER) AND (VAL(X$) < RING.BACK.COUNT) THEN _
  977.        RING.ANSWER = TRUE
  978. 300 RING.BACK.COUNT = VAL(X$)
  979.     Q = RING.BACK.COUNT + 1
  980.     IF (NOT RING.ANSWER) THEN _
  981.        Q = 0
  982. 305 LOCATE 20,56
  983.     CALL LPRNT(TIME$ + " Ring " + STR$(Q),0)
  984. 310 IF (RING.BACK.COUNT + 1 < REQUIRED.RINGS) OR _
  985.        (NOT RING.ANSWER) THEN _
  986.        GOTO 239
  987. 320 IF PCJR THEN _
  988.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  989.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  990.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  991.     ELSE A$ = MODEM.ANSWER.COMMAND$
  992.     CALL MODEMPUT (A$)
  993. '
  994. '
  995. ' *  TEST FOR CARRIER PRESENT
  996. '
  997. '
  998. 321 CALL SETABORT (CONNECT.DELAY!,MAX.CARRIER.WAIT)
  999.     IF CONNECT.DELAY! > 86399 THEN _
  1000.        CONNECT.DELAY! = 86399
  1001. 322 CALL FINDTIME (TI!)
  1002. 323 SUBROUTINE.PARAMETER = -10
  1003.     CALL CARRIER
  1004.     IF SUBROUTINE.PARAMETER AND _
  1005.        TI! < CONNECT.DELAY! THEN _
  1006.        GOTO 322
  1007.     IF SUBROUTINE.PARAMETER THEN _
  1008.        SUBROUTINE.PARAMETER = 4 : _
  1009.        EXIT SUB
  1010.     CALL DELAYIT (3)
  1011. 324 SUBROUTINE.PARAMETER = 0
  1012.     IF TI! > CONNECT.DELAY! THEN _
  1013.        CALL UPDTCALR ("Connect timeout",1) : _
  1014.        SUBROUTINE.PARAMETER = 4 : _
  1015.        EXIT SUB
  1016. 325 CALL FLUSHCOM(X$)
  1017.     IF SUBROUTINE.PARAMETER = -1 THEN _
  1018.        IF EC = 69 THEN _
  1019.           SUBROUTINE.PARAMETER = 5 : _
  1020.        EXIT SUB
  1021.     MODEM.RESPONSE$ = MODEM.RESPONSE$ + X$
  1022.     CALL FINDTIME (TI!)
  1023.     IF TI! > CONNECT.DELAY! THEN _
  1024.        CALL UPDTCALR ("Connect timeout",1) : _
  1025.        SUBROUTINE.PARAMETER = 4 : _
  1026.        EXIT SUB
  1027.     IF DUMB.MODEM THEN _
  1028.        BAUD.TEST! = VAL(MODEM.INIT.BAUD$) : _                        ' KG090102
  1029.        GOTO 327
  1030.     IF INSTR(MODEM.RESPONSE$,"FAST") THEN _
  1031.        BAUD.TEST! = 19200 : _                                        ' KG090102
  1032.        GOTO 327
  1033.     IF INSTR(MODEM.RESPONSE$,"ONNECT") THEN _
  1034.        BAUD.TEST! = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONNECT") + 7)) : _ ' KGO90102
  1035.        GOTO 327
  1036.     IF INSTR(MODEM.RESPONSE$,"ONLINE") THEN _
  1037.        BAUD.TEST! = VAL(MID$(MODEM.RESPONSE$,INSTR(MODEM.RESPONSE$,"ONLINE") + 7)) : _ ' KG090102
  1038.        GOTO 327
  1039.     GOTO 324
  1040. 327 CALL TESTREL (MODEM.RESPONSE$)
  1041. 328 IF BAUD.TEST! = 0 OR BAUD.TEST! = 300 THEN _                     ' KG090102
  1042.        BAUD.TEST! = 300 : _                                          ' KG090102
  1043.        BPS = -1 : _
  1044.        GOTO 331
  1045.     IF BAUD.TEST! = 1200 OR BAUD.TEST! = 1275 THEN _                 ' KG090102
  1046.        BPS = -3 : _
  1047.        GOTO 331
  1048.     IF BAUD.TEST! = 2400 THEN _                                      ' KG090102
  1049.        BPS = -4 : _
  1050.        GOTO 331
  1051.     IF BAUD.TEST! = 4800 OR BAUD.TEST! = 9600 THEN _                 ' KG090102
  1052.        BPS = -4-(BAUD.TEST! /4800) : _                               ' KG090102
  1053.        GOTO 331
  1054.     IF BAUD.TEST! = 19200 THEN _                                     ' KG090102
  1055.        BPS = -7 : _
  1056.        GOTO 331
  1057.     IF BAUD.TEST! = 38400 THEN _                                     ' KG090201
  1058.        BPS = -8 : _                                                  ' KG090102
  1059.        GOTO 331                                                      ' KG090102
  1060.     GOTO 324
  1061. 331 CALL SETBAUD
  1062.     SUBROUTINE.PARAMETER = 2
  1063. 335 DONT.WRITE = 0
  1064.     END SUB
  1065. 336 ' $SUBTITLE: 'TESTREL - Test for Reliable mode connection'
  1066. ' $PAGE
  1067. '
  1068. '  NAME    -- TESTREL
  1069. '
  1070. '  INPUTS  --     PARAMETER                    MEANING
  1071. '                 STRNG$                 String to check for reliable
  1072. '
  1073. '  OUTPUTS --    RELIABLE.MODE          Reliable mode indicator
  1074. '
  1075. '  PURPOSE -- To test for reliable connect
  1076. '
  1077.     SUB TESTREL (STRNG$) STATIC
  1078.     RELIABLE.MODE = FALSE
  1079.     IF STRNG$ = "" THEN _
  1080.        EXIT SUB
  1081.     IF INSTR(STRNG$,"REL") OR _
  1082.        INSTR(STRNG$,"R C") OR _       (ERROR CONTROL)
  1083.        INSTR(STRNG$,"ARQ") OR _
  1084.        INSTR(STRNG$,"LAP") OR _
  1085.        INSTR(STRNG$,"AFT") OR _
  1086.        INSTR(STRNG$,"MNP") THEN _
  1087.          RELIABLE.MODE = -1
  1088.     END SUB
  1089. 455 ' $SUBTITLE: 'BADCHAR - sub to check user names for bad characters'
  1090. ' $PAGE
  1091. '
  1092. '  NAME    -- BADCHAR
  1093. '
  1094. '  INPUTS  --     PARAMETER                    MEANING
  1095. '                PASSED.NAME$           USER NAME
  1096. '
  1097. '  OUTPUTS --    PASSED.NAME$           USER NAME WILL CONTAIN ""
  1098. '                                       IF BAD CHARACTERS FOUND
  1099. '
  1100. '  PURPOSE -- To check user names for invalid characters
  1101. '
  1102.     SUB BADCHAR (PASSED.NAME$) STATIC
  1103.     J = 1
  1104.     XX = LEN(PASSED.NAME$)
  1105. 457 IF J > XX THEN _
  1106.        EXIT SUB
  1107.     X$ = MID$(PASSED.NAME$,J,1)
  1108.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",X$) = 0 THEN _
  1109.        PASSED.NAME$ = "" : _
  1110.        EXIT SUB
  1111.     J = J + 1
  1112.     GOTO 457
  1113.     END SUB
  1114. 660 ' $SUBTITLE: 'PASSWRD - verify User and Message passwords'
  1115. ' $PAGE
  1116. '
  1117. '  NAME    -- PASSWRD
  1118. '
  1119. '  INPUTS  --     PARAMETER                    MEANING
  1120. '             SUBROUTINE.PARAMETER = 1  VERIFY USER PASSWORD
  1121. '                                  = 2  VERIFY MESSAGE PASSWORD
  1122. '                                  = 3  VERIFY MESSAGE PASSWORD
  1123. '                                  = 4  VERIFY MESSAGE PASSWORD
  1124. '                                  = 5  VERIFY MESSAGE PASSWORD
  1125. '
  1126. '  OUTPUTS -- PASSWORD.FAILED           SET TO 0 IF PASSED
  1127. '                                       SET TO -1 IF FAILED
  1128. '
  1129. '  PURPOSE -- To verify user and message passwords
  1130. '
  1131.     SUB PASSWRD STATIC
  1132.     EC = 0
  1133.     ON SUBROUTINE.PARAMETER GOTO 665,667,670,675,677
  1134. 665 IF PASSWORD.SAVE$ = PASSWORD$ THEN _
  1135.        PASSWORD.FAILED = 0 : _
  1136.        EXIT SUB
  1137. 667 ATTEMPTS = 0
  1138. 670 ATTEMPTS = ATTEMPTS + 1
  1139.     IF ATTEMPTS > ATTEMPTS.ALLOWED THEN _
  1140.        PASSWORD.FAILED = TRUE : _
  1141.        EXIT SUB
  1142. 675 A$ = "Enter Password (dots echo)"
  1143.     HIDDEN = TRUE
  1144.     SUBROUTINE.PARAMETER = 1
  1145.     CALL TGET
  1146.     IF SUBROUTINE.PARAMETER < 0 THEN _
  1147.        PASSWORD.FAILED = TRUE : _
  1148.        EXIT SUB
  1149.     HIDDEN = FALSE
  1150.     Z$ = B$
  1151. 677 IF LEN(Z$) > 15 THEN _
  1152.        GOTO 680
  1153.     IF EC <> 0 THEN _
  1154.        GOTO 670
  1155.     CALL ALLCAPS (Z$)
  1156.     Z$ = Z$ + SPACE$(15 - LEN(Z$))
  1157.     IF PASSWORD.SAVE$ = Z$ THEN _
  1158.        PASSWORD.FAILED = 0 : _
  1159.        A$ = "" : _
  1160.        EXIT SUB
  1161. 680 CALL QTPUT1 ("Wrong password ")
  1162.     IF NOT MESSAGE.PASSWORD THEN _
  1163.        CALL UPDTCALR (ACTIVE.USER.NAME$+" PW fail: " + Z$,1)
  1164.     GOTO 670
  1165.     END SUB
  1166. 945 ' $SUBTITLE: 'LINE25 - sub to build/display RBBS-PCs line 25'
  1167. ' $PAGE
  1168. '
  1169. '  NAME    -- LINE25
  1170. '
  1171. '  INPUTS  --     PARAMETER                    MEANING
  1172. '             SUBROUTINE.PARAMETER = 1  BUILD DISPLAY FOR LINE 25
  1173. '             SUBROUTINE.PARAMETER = 2  UPDATE LINE 25
  1174. '             LOCK.STATUS$              STATUS OF LOCKS IN A MULTI-
  1175. '                                       USER ENVIRONMENT OR TIME OF
  1176. '                                       DAY USER LOGGED ON OR THE
  1177. '                                       RE-CYCLED
  1178. '
  1179. '  OUTPUTS -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1180. '             CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1181. '
  1182. '  PURPOSE -- To build or update RBBS-PC's line 25 displayed
  1183. '             on the PC screen that is running RBBS-PC.
  1184. '
  1185.       SUB LINE25 STATIC
  1186.       IF SUBROUTINE.PARAMETER = 2 THEN _
  1187.          GOTO 950
  1188. '
  1189. '
  1190. ' *  BUILD LINE 25 DISPLAY
  1191. '
  1192. '
  1193. 949 LINE.25$ = "Node " + _
  1194.                NODE.ID$ + " " + _
  1195.                PAGE.STATUS$ + " " + _
  1196.                MID$("    AVL ",1 - 4 * SYSOP.AVAILABLE,4) + _
  1197.                MID$("    ANY ",1 - 4 * SYSOP.ANNOY,4) + _
  1198.                MID$("    LPT ",1 - 4 * PRINTER,4) + _
  1199.                MID$("SYS",1,-3 * SYSOP.NEXT) + _
  1200.                MID$(" XOFF",1,-5 * XOFF.ED) + _
  1201.                MID$(" CTS",1,-4 * NOT.CTS)
  1202. '
  1203. '
  1204. ' *  LINE 25 UPDATE ROUTINE
  1205. '
  1206. '
  1207. 950 IF NOT SNOOP THEN _
  1208.        EXIT SUB
  1209.     CURSOR.LINE = CSRLIN
  1210.     CURSOR.ROW = POS(0)
  1211.     HH = LEN(ACTIVE.USER.NAME$) + _
  1212.          LEN(CI$) + _
  1213.          LEN(LINE.25$) + _
  1214.          LEN(STR$(USER.SECURITY.LEVEL)) + _
  1215.          18
  1216. '    IF AUTODOWNLOAD.AVAILABLE THEN _
  1217. '       HH = HH + 4
  1218.     LOCATE 25,1
  1219.     IF NETWORK.TYPE = 0 THEN _
  1220.        IF AUTODOWNLOAD.AVAILABLE THEN _
  1221.           LOCK.STATUS$ = SPACE$(3) + _
  1222.                          "AD  " + _
  1223.                          TIME.LOGGED.ON$ _
  1224.        ELSE LOCK.STATUS$ = SPACE$(3) + _
  1225.                            TIME.LOGGED.ON$
  1226.     IF HH > 79 THEN _
  1227.        HH = 78
  1228.     LINE.25.HOLD$ = LINE.25$ + _
  1229.                     SPACE$(79 - HH) + _
  1230.                     STR$(USER.SECURITY.LEVEL) + _
  1231.                     " " + _
  1232.                     ACTIVE.USER.NAME$ + _
  1233.                     " " + _
  1234.                     CI$ + _
  1235.                     " " + _
  1236.                     LOCK.STATUS$
  1237.     CALL LPRNT(LINE.25.HOLD$,0)
  1238.     LOCATE CURSOR.LINE,CURSOR.ROW
  1239.     END SUB
  1240. 1238 ' $SUBTITLE: 'SRCHCMND    - sub to search command list'
  1241. ' $PAGE
  1242. '
  1243. '  NAME    -- SRCHCMND
  1244. '
  1245. '  INPUTS  -- PARAMETER             MEANING
  1246. '             STRT.POS      POSITION TO BEGIN SEARCH AT
  1247. '             ALL.OPTS$     STRING TO SEARCH (COMMAND LIST)
  1248. '             Z$            WHAT TO LOOK FOR
  1249. '
  1250. '  OUTPUTS -- WHERE.FOUND   POSITION OF Z$ IN ALL.OPTS$
  1251. '                           0 IF NOT FOUND
  1252. '
  1253. '  PURPOSE -- Searches valid command list for the requested
  1254. '             command.  If the sysop has configured RBBS-PC to
  1255. '             restrict commands to only those valid within the
  1256. '             RBBS-PC subsystem, then only those commands and
  1257. '             "GLOBAL" commands are valid.  Otherwise all commands
  1258. '             are valid from any of the RBBS-PC subsections.
  1259. '
  1260.      SUB SRCHCMND (STRT.POS,WHERE.FOUND) STATIC
  1261. 1240 IF LEN(Z$) < 1 THEN _
  1262.         WHERE.FOUND = 0 : _
  1263.         EXIT SUB
  1264.      CALL ALLCAPS (Z$)
  1265.      Y$ = LEFT$(Z$,1)
  1266.      WHERE.FOUND = INSTR(STRT.POS,ALL.OPTS$,Y$)
  1267.      IF WHERE.FOUND = 0 THEN _  'Not found: decide whether to hunt further
  1268.         IF STRT.POS < 2 OR RESTRICT.VALID.CMDS THEN _
  1269.            GOTO 1242 _  ' fully searched or restricted
  1270.         ELSE WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _ 'hunt further
  1271.              GOTO 1242
  1272.      IF WHERE.FOUND => BEG.LIBRARY THEN _
  1273.         IF WHERE.FOUND < LEN(ALL.OPTS$) - 11 THEN _
  1274.            IF LIBRARY.TYPE = 0 THEN _
  1275.               WHERE.FOUND = INSTR(WHERE.FOUND+1,ALL.OPT$,Y$) : _
  1276.               IF WHERE.FOUND = 0 THEN _
  1277.                  WHERE.FOUND = INSTR(1,ALL.OPTS$,Y$) : _
  1278.                  IF WHERE.FOUND >= BEG.LIBRARY OR WHERE.FOUND = 0 THEN _
  1279.                     WHERE.FOUND = 0 : _
  1280.                     GOTO 1242
  1281.      IF NOT RESTRICT.VALID.CMDS THEN _
  1282.         GOTO 1242            ' everything found valid
  1283. '
  1284. '
  1285. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)
  1286. '
  1287. '
  1288.      IF WHERE.FOUND > LEN(ALL.OPTS$) - 11 THEN _
  1289.         IF USER.SECURITY.LEVEL < OPT.SEC(WHERE.FOUND) THEN _
  1290.            WHERE.FOUND = 0 : _
  1291.            EXIT SUB _
  1292.         ELSE GOTO 1242                                               ' KG060701
  1293.      IF MID$(ORIG.COMMANDS$,WHERE.FOUND,1) = "G" THEN _
  1294.         GOTO 1242          ' ACCEPT GOODBYE/GRAPHICS                 ' KG060701
  1295.      IF (WHERE.FOUND < STRT.POS) OR _
  1296.         (STRT.POS < BEG.FILE AND WHERE.FOUND => BEG.FILE ) OR _
  1297.         (STRT.POS < BEG.UTIL AND WHERE.FOUND => BEG.UTIL ) OR _
  1298.         (STRT.POS < BEG.LIBRARY AND WHERE.FOUND => BEG.LIBRARY ) THEN _
  1299.            WHERE.FOUND = 0                 ' REJECT: NOT IN SECTION
  1300. 1242 IF WHERE.FOUND > 0 THEN _                                       ' KG060701
  1301.         LSET LAST.COMMAND$ = ACTIVE.MENU$ + MID$(ORIG.COMMANDS$,WHERE.FOUND) : _
  1302.         EXIT SUB                                                     ' KG060701
  1303.      IF MACRO.ACTIVE OR LEN(Z$) <> 1 THEN _                          ' KG060701
  1304.         EXIT SUB
  1305.      CALL ACHKMAC (Z$,FOUND)
  1306.      IF FOUND THEN _
  1307.         CALL FDMACEXE : _
  1308.         Z$ = B$(1) : _
  1309.         GOTO 1240
  1310.      END SUB
  1311. 1320 ' $SUBTITLE: 'CHKMACRO - sub to check if macro exists & process'
  1312. ' $PAGE
  1313. '
  1314. '  NAME    -- CHKMACRO
  1315. '
  1316. '  INPUTS  -- PARAMETER             MEANING
  1317. '             STRNG$           STRING TO CHECK IF IS A MACRO
  1318. '             MACRO.DRVPATH$   DRIVE/PATH WHERE MACROS ARE
  1319. '             MACRO.EXTENSION$ EXTENSION OF MACROS
  1320. '             MACRO.OFF        FORCE NO MACRO TO BE FOUND
  1321. '
  1322. '  OUTPUTS -- MACRO.FOUND      WHETHER A MACRO WAS FOUND
  1323. '             STRNG$           SUBSTITUTE FOR COMMANDS
  1324. '             COMMPORT.STACK$  REST OF MACRO
  1325. '                              0 IF NOT FOUND
  1326. '
  1327. '  PURPOSE -- Macro file is checked for security (1st line).
  1328. '             2nd line is substituted for passed string
  1329. '             and parsed.  Remaining part of macro put into
  1330. '             stack to be executed.
  1331. '
  1332.      SUB CHKMACRO (STRNG$,MACRO.FOUND) STATIC
  1333.      MACRO.FOUND = FALSE
  1334.      IF MACRO.EXTENSION$ = "" THEN _                                 ' KG060701
  1335.         EXIT SUB                                                     ' KG060701
  1336.      IF LEN(STRNG$) < MACRO.MIN THEN _
  1337.         MACRO.MIN = 1 : _
  1338.         EXIT SUB
  1339.      IF LEN(STRNG$) = 1 THEN _
  1340.         TEMP$ = STRNG$ : _
  1341.         CALL ALLCAPS (TEMP$) : _
  1342.         IF INSTR(ALL.OPTS$,TEMP$) > 0 THEN _
  1343.            EXIT SUB
  1344.      CALL ACHKMAC (STRNG$,MACRO.FOUND)
  1345.      END SUB
  1346. 1325 ' $SUBTITLE: 'ACHKMAC - check if macro exists & process'
  1347. ' $PAGE
  1348. '
  1349. '  NAME    -- ACHKMAC
  1350. '
  1351. '  INPUTS  -- PARAMETER             MEANING
  1352. '             STRNG$           STRING TO CHECK IF IS A MACRO
  1353. '             MACRO.DRVPATH$   DRIVE/PATH WHERE MACROS ARE
  1354. '             MACRO.EXTENSION$ EXTENSION OF MACROS
  1355. '             MACRO.OFF        FORCE NO MACRO TO BE FOUND
  1356. '
  1357. '  OUTPUTS -- MACRO.FOUND      WHETHER A MACRO WAS FOUND
  1358. '             STRNG$           SUBSTITUTE FOR COMMANDS
  1359. '             COMMPORT.STACK$  REST OF MACRO
  1360. '                              0 IF NOT FOUND
  1361. '
  1362. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  1363. '             letter uses a command.
  1364.      SUB ACHKMAC (STRNG$,MACRO.FOUND) STATIC
  1365.      MACRO.FOUND = FALSE                                             ' KG081101
  1366.      TEMP$ = STRNG$
  1367.      CALL BRKFNAME (TEMP$,DF$,PREFX$,X$,FALSE)
  1368.      IF TEMP$ = PREFX$ THEN _
  1369.         FILNAME$ = MACRO.DRVPATH$ + STRNG$ + MACRO.EXTENSION$ _
  1370.      ELSE FILNAME$ = STRNG$
  1371.      CALL BADFILE (FILNAME$,A)
  1372.      IF A > 1 THEN _
  1373.         EXIT SUB
  1374.      CALL GRAPHICX (USER.GRAPHIC.DEFAULT$,FILNAME$,6)                ' KG061001
  1375.      IF NOT OK THEN _
  1376.         EXIT SUB                                                     ' KG061001
  1377.      CALL READDIR (6,1)
  1378.      IF EC > 0 THEN _
  1379.         EXIT SUB
  1380.      CALL CHECKINT (A$)
  1381.      IF EC > 0 OR USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _
  1382.         EXIT SUB
  1383.      A = INSTR(A$,"/")                                               ' KG060701
  1384.      IF A > 0 THEN _    ' Check macro contraint                      ' KG060701
  1385.         X$ = RIGHT$(A$,LEN(A$)-A) : _                                ' KG060701
  1386.         IF LEFT$(LAST.COMMAND$,LEN(X$)) <> X$ THEN _                 ' KG060701
  1387.            EXIT SUB                                                  ' KG060701
  1388.      MACRO.ACTIVE = TRUE
  1389.      MACRO.FOUND = TRUE
  1390.      MACRO.ECHO = TRUE
  1391.      END SUB
  1392. 1330 ' $SUBTITLE: 'VIEWHELP    - Processes requests for help'
  1393. ' $PAGE
  1394. '
  1395. '  NAME    -- VIEWHELP
  1396. '
  1397. '  INPUTS  -- PARAMETER             MEANING
  1398. '            SECTION             ORDER OF 1ST COMMAND IN CURRENT
  1399. '                                   SECTION
  1400. '            GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1401. '            HELP.DEFAULT$       HELP GET IF PRESS ENTER
  1402. '            HELP.PATH$
  1403. '            HELP.EXTENSION$
  1404. '            BEG.FILE
  1405. '            BEG.MAIN
  1406. '            BEG.UTIL
  1407. '            BEG.LIBRARY
  1408. '
  1409. '  OUTPUTS -- DISPLAYS HELP
  1410. '
  1411. '  PURPOSE -- The main help processor for RBBS.  Puts up the
  1412. '             optional menu.  Accepts help with individual commands.
  1413. '
  1414.      SUB VIEWHELP (SECTION,GRAPHIC.DEFAULT$,HELP.DEFAULT$) STATIC
  1415.      HELP.MENU$ = HELP.PATH$ + _
  1416.                   "HELP" + _
  1417.                   HELP.EXTENSION$
  1418.      GOT.MENU = TRUE
  1419.      IF Q > 1 THEN _
  1420.         ANS.INDEX = 2 : _
  1421.         LAST.INDEX = Q: _
  1422.         FAST.HELP = TRUE : _
  1423.         GOTO 1332
  1424. 1331 IF GOT.MENU THEN _
  1425.         FILE.NAME$ = HELP.MENU$ : _
  1426.         GOSUB 1350 : _
  1427.         GOT.MENU = FALSE
  1428.      ANS.INDEX = 1
  1429.      A$ = "Help with what Command (or TOPIC name)" + _
  1430.           PRESS.ENTER.EXPERT$
  1431.      SUBROUTINE.PARAMETER = 1
  1432.      CALL TGET
  1433.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1434.         EXIT SUB
  1435.      IF Q = 0 THEN _
  1436.         EXIT SUB
  1437.      LAST.INDEX = Q
  1438. 1332 Z$ = B$(ANS.INDEX)
  1439.      CALL ALLCAPS (Z$)
  1440.      IF Z$ = "?" THEN _
  1441.         Z$ = "H"
  1442.      CALL BADFILE (Z$,BAD.FILE.NAME.INDEX)
  1443.      ON BAD.FILE.NAME.INDEX GOTO 1333,1340,1340
  1444. 1333 IF LEN(Z$) = 1 THEN _
  1445.         CALL SRCHCMND (SECTION,FF) : _
  1446.         IF FF < 1 THEN _
  1447.            OK = FALSE : _
  1448.            GOTO 1334 _
  1449.         ELSE X = - (FF => BEG.MAIN) - (FF => BEG.FILE) - (FF => BEG.UTIL) - (FF => BEG.LIBRARY) : _
  1450.              Z$ = MID$("MFU@",X,1) + _
  1451.                   MID$(ORIG.COMMANDS$,FF,1)
  1452.      FILE.NAME$ = HELP.PATH$ + _
  1453.                   Z$ + _
  1454.                   HELP.EXTENSION$
  1455.      GOSUB 1350
  1456. 1334 IF NOT OK THEN _
  1457.         A$ = "No help for " + _
  1458.              Z$ : _
  1459.         CALL QTPUT1 (A$) : _
  1460.         CALL UPDTCALR (A$,2)
  1461.      ANS.INDEX = ANS.INDEX + 1
  1462.      IF ANS.INDEX <= LAST.INDEX THEN _
  1463.         GOTO 1332
  1464.      IF FAST.HELP THEN _
  1465.         FAST.HELP = FALSE : _
  1466.         EXIT SUB
  1467.      GOTO 1331
  1468. 1340 OK = FALSE
  1469.      GOTO 1334
  1470. 1350 CALL GRAPHIC (GRAPHIC.DEFAULT$,FILE.NAME$)
  1471.      CALL BUFFILE (FILE.NAME$,X)
  1472.      RETURN
  1473.      END SUB
  1474. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1475. ' $PAGE
  1476. '
  1477. '  NAME    -- SVIOLATION
  1478. '
  1479. '  INPUTS  --     PARAMETER                    MEANING
  1480. '
  1481. '  OUTPUTS -- CURSOR.LINE               CURRENT LINE ON SCREEN
  1482. '             CURSOR.ROW                CURRENT ROW ON CURSOR.LINE
  1483. '
  1484. '  PURPOSE -- Inform caller of security violation, augment count of
  1485. '             violations and determine whether too many occurred.
  1486. '
  1487.      SUB SVIOLATION STATIC
  1488.      CALL BUFFILE (SECVIO.HLP$,X)
  1489.      IF NOT OK THEN _
  1490.         CALL QTPUT1 ("Sorry, " + FIRST.NAME$ + ", Security to LOW for this Feature")
  1491.      CALL UPDTCALR ("SV!-" + VIOLATION$,2)
  1492. '     CALL MUZAK (3)
  1493.      VIOLATIONS.THIS.SESSION = VIOLATIONS.THIS.SESSION + 1
  1494.      IF MAXIMUM.VIOLATIONS = 0 OR VIOLATIONS.THIS.SESSION <= MAXIMUM.VIOLATIONS THEN _
  1495.         EXIT SUB
  1496. 1385 IF USER.FILE.INDEX < 1 THEN _
  1497.         EXIT SUB
  1498.      A$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1499.      IF USER.SECURITY.LEVEL <= MINIMUM.LOGON.SECURITY THEN _
  1500.         A$ = "" : _
  1501.         USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - 1 _
  1502.      ELSE USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY
  1503.      DENY.ACCESS = TRUE
  1504.      END SUB
  1505. 1386 ' $SUBTITLE: 'DENYACCESS - sub to permanently deny access'
  1506. ' $PAGE
  1507. '
  1508. '  NAME    -- DENYACCESS
  1509. '
  1510. '  INPUTS  --     PARAMETER                    MEANING
  1511. '
  1512. '  OUTPUTS -- (USER'S RECORD)
  1513. '
  1514. '  PURPOSE -- Permanently resets user's security level when access denied
  1515. '
  1516.      SUB DENYACCESS STATIC
  1517.      CALL TPUT
  1518.      LOGON.ERROR.INDEX = 5
  1519.      SUBROUTINE.PARAMETER = 6
  1520.      CALL FILELOCK
  1521.      CALL OPENUSER (HIGHEST.USER.RECORD)
  1522.      FIELD 5, 128 AS USER.RECORD$
  1523.      GET 5,USER.FILE.INDEX
  1524.      MID$(USER.RECORD$,47,2) = MKI$(USER.SECURITY.LEVEL)
  1525.      PUT 5,USER.FILE.INDEX
  1526.      SUBROUTINE.PARAMETER = 8
  1527.      CALL FILELOCK
  1528.      END SUB
  1529. 1396 ' $SUBTITLE: 'TPUT -- common routine to write to comm. port'
  1530. ' $PAGE
  1531. '
  1532. '  NAME    -- TPUT (TERMINAL PUT)
  1533. '
  1534. '  INPUTS  --     PARAMETER                    MEANING
  1535. '                     A$                 STRING TO WRITE TO THE
  1536. '                                        COMMUNICATIONS PORT
  1537. '              SUBROUTINE.PARAMETER = 1  SKIP A LINE BEFORE WRITING
  1538. '                                        TO THE COMMUNICATIONS PORT
  1539. '                                   = 2  SKIP A LINE BEFORE WRITING
  1540. '                                        TO THE COMMUNICATIONS PORT
  1541. '                                        AND THEN SKIP TWO LINES
  1542. '                                        AFTER WRITING TO THE COMM-
  1543. '                                        UNICATIONS PORT
  1544. '                                   = 3  WRITE TO THE COMMUNICATIONS
  1545. '                                        PORT AND THEN SKIP TWO LINES
  1546. '                                   = 4  WRITE TO THE COMMUNICATIONS
  1547. '                                        PORT WITHOUT A CR/LF
  1548. '                                   = 5  WRITE TO THE COMMUNICATIONS
  1549. '                                        PORT WITH A CR/LF
  1550. '                                   = 6  RESET EVERYTHING FOR INPUT STRING
  1551. '                                   = 7  RE-ENTRY AFTER HANDLING A
  1552. '                                        FUNCTION KEY
  1553. '
  1554. '  OUTPUTS --  SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1555. '              FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1556. '
  1557. '  PURPOSE --  Common output routine for RBBS-PC to the
  1558. '              communications port (terminal put)
  1559.       SUB TPUT STATIC
  1560.       IF SUBROUTINE.PARAMETER <> 7 THEN _
  1561.          PARM = SUBROUTINE.PARAMETER
  1562.       ON SUBROUTINE.PARAMETER GOTO 1398,1399,1400,1403,1405,1450,1411
  1563. '
  1564. '
  1565. ' *  COMMON OUTPUT ROUTINE
  1566. '
  1567. '
  1568. 1398 CALL SKIPLINE (1)
  1569.      GOTO 1405
  1570. 1399 CALL SKIPLINE (1)
  1571. 1400 CR = 1
  1572. 1403 CR = CR + 1
  1573. 1405 RET = FALSE
  1574.      IF CM THEN _
  1575.         GOTO 1435
  1576. 1410 CALL FINDFUNC
  1577.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1578.         EXIT SUB
  1579. 1411 Y$ = KEY.PRESSED$
  1580.      SUBROUTINE.PARAMETER = PARM
  1581.      IF LOCAL.USER THEN _
  1582.         GOTO 1430
  1583.      CALL EOFCOMM (CHAR%)
  1584.      IF CHAR% = -1 THEN _
  1585.         CALL CHKCARRIER : _                                          ' KG061203
  1586.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1587.            EXIT SUB _
  1588.         ELSE GOTO 1430
  1589.      CALL GETCOM(Y$)
  1590. 1425 IF SUBROUTINE.PARAMETER = -1 THEN _
  1591.         EXIT SUB
  1592. 1430 IF Y$ = "" THEN _
  1593.         GOTO 1435
  1594.      ON INSTR(INTERRUPT.ON$,Y$) GOTO 1434,1434,1473,1475,1433
  1595.      GOSUB 1476
  1596.      GOTO 1435
  1597. 1433 GOSUB 1476
  1598.      IF ASC(RIGHT$(COMMPORT.STACK$,2)) = 13 OR _
  1599.         STOP.INTERRUPTS THEN _
  1600.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1601.      GOTO 1471
  1602. 1434 IF STOP.INTERRUPTS THEN _
  1603.         GOTO 1435
  1604.      COMMPORT.STACK$ = ""
  1605.      IF FOSSIL THEN _
  1606.         CALL FOSTXPURGE(COMPORT%) : _
  1607.         CALL FOSRXPURGE(COMPORT%)
  1608.      GOTO 1471
  1609. 1435 LOCATE ,,1
  1610.      CALL LPRNT (A$,0)
  1611. 1437 IF UPPER.CASE THEN _
  1612.         IF GR <> 2 THEN _
  1613.            CALL ALLCAPS (A$)
  1614.      CALL PUTCOM (A$)
  1615. 1450 IF CR <> 1 THEN _
  1616.         CALL SKIPLINE (1) _
  1617.      ELSE IF CR > 1 THEN _
  1618.              CALL SKIPLINE (1)
  1619. 1470 CR = 0
  1620.      TOA! = FRE("A")
  1621.      EXIT SUB
  1622. 1471 CALL SKIPLINE (1)
  1623.      STOP.INTERRUPTS = FALSE
  1624.      RET = TRUE
  1625.      NO = TRUE                                                       ' KG060401
  1626.      NON.STOP = FALSE
  1627.      GOTO 1470
  1628. 1473 XOFF.ED = TRUE
  1629.      GOTO 1410
  1630. 1475 XOFF.ED = FALSE
  1631.      GOTO 1410
  1632. 1476 IF ASC(Y$) < 127 THEN _
  1633.         COMMPORT.STACK$ = COMMPORT.STACK$ + Y$
  1634.      RETURN
  1635.      END SUB
  1636. 1478 ' $SUBTITLE: 'QTPUT - subroutine to quickly write to terminal'
  1637. ' $PAGE
  1638. '
  1639. '  NAME    -- QTPUT
  1640. '
  1641. '  INPUTS  -- PARAMETER             MEANING
  1642. '             STRNG$        STRING TO WRITE OUT
  1643. '             NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1644. '
  1645. '  OUTPUTS -- NONE
  1646. '
  1647. '  PURPOSE -- Subroutine to quickly write to the terminal.  This is
  1648. '             different from "TPUT" in the things it doesn't do:
  1649. '                A.) NO function key check,
  1650. '                B.) NO conversion to upper case,
  1651. '                C.) NO check for carrier present
  1652. '                D.) NO check for imbedded carriage return in "STRNG$"
  1653. '                E.) NO support for XON/XOFF
  1654. '
  1655.       SUB QTPUT (STRNG$,NUM.RETURNS) STATIC
  1656.       IF USE.TPUT THEN _
  1657.          A$ = STRNG$ : _
  1658.          SUBROUTINE.PARAMETER = 4 : _
  1659.          CALL TPUT : _
  1660.          CALL SKIPLINE (NUM.RETURNS) : _
  1661.          EXIT SUB
  1662.       CALL PUTCOM (STRNG$)
  1663.       LOCATE ,,1
  1664.       CALL LPRNT (STRNG$,0)
  1665.       CALL SKIPLINE (NUM.RETURNS)
  1666.       END SUB
  1667.       SUB QTPUT1 (STRNG$) STATIC
  1668.       CALL QTPUT (STRNG$,1)
  1669.       END SUB
  1670. 1480 ' $SUBTITLE: 'LPRNT    - subroutine to write to display'
  1671. ' $PAGE
  1672. '
  1673. '  NAME    -- LPRNT
  1674. '
  1675. '  INPUTS  -- PARAMETER             MEANING
  1676. '             STRNG$        STRING TO WRITE OUT
  1677. '             NUM.RETURNS   NUMBER OF CARRIAGE RETURNS
  1678. '
  1679. '  OUTPUTS -- NONE
  1680. '
  1681. '  PURPOSE -- Subroutine to write to the display.
  1682. '
  1683.       SUB LPRNT (STRNG$,NUM.RETURNS) STATIC
  1684.       IF NOT SNOOP THEN _
  1685.          EXIT SUB
  1686.       CALL PSCRN (STRNG$)
  1687. '      IF VOICE.TYPE <> 0 AND TALK.ALL THEN _
  1688. '         CALL TALK (65,STRNG$)
  1689.       IF USE.BASIC.WRITES THEN _
  1690.          FOR I = 1 TO NUM.RETURNS : _
  1691.             PRINT : _
  1692.          NEXT : _
  1693.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1694.               LOCATE ,,1 : _
  1695.               CALL ANSI(CRLF$,C.L,C.C) : _
  1696.               LOCATE C.L,C.C : _
  1697.               NEXT
  1698.       END SUB
  1699. 1482 ' $SUBTITLE: 'QLPRNT - subroutine to quickly write to display'
  1700. ' $PAGE
  1701. '
  1702. '  NAME    -- QLPRNT
  1703. '
  1704. '  INPUTS  -- PARAMETER             MEANING
  1705. '             STRNG$        STRING TO WRITE OUT
  1706. '             NUM           NUMBER OF CARRIAGE RETURNS
  1707. '
  1708. '  OUTPUTS -- NONE
  1709. '
  1710. '  PURPOSE -- Subroutine to quickly write to the display.
  1711. '             Overwrites, and puts up count
  1712.       SUB QLPRNT (STRNG$,NUM) STATIC
  1713.       LOCATE ,1,1
  1714.       CALL LPRNT (STRNG$ + STR$(NUM),0)
  1715.       END SUB
  1716. 1483 ' $SUBTITLE: 'PSCRN    - subroutine to print to the screen'
  1717. ' $PAGE
  1718. '
  1719. '  NAME    -- PSCRN
  1720. '
  1721. '  INPUTS  -- PARAMETER             MEANING
  1722. '             STRNG$        STRING TO WRITE OUT
  1723. '
  1724. '  OUTPUTS -- NONE
  1725. '
  1726. '  PURPOSE -- Writes to local screen regardless of whether you have
  1727. '             carrier.  Assumes have positioned cursor where you want.
  1728. '
  1729.       SUB PSCRN (STRNG$) STATIC
  1730.       IF STRNG$ = "" THEN _
  1731.          EXIT SUB
  1732.       IF USE.BASIC.WRITES THEN _
  1733.          PRINT STRNG$; _
  1734.       ELSE CALL ANSI (STRNG$,C.L,C.C) : _
  1735.            LOCATE C.L,C.C
  1736.       END SUB
  1737. 1485 ' $SUBTITLE: 'SKIPLINE - sub to write a blank line to user'
  1738. ' $PAGE
  1739. '
  1740. '  NAME    -- SKIPLINE
  1741. '
  1742. '  INPUTS  --   PARAMETER             MEANING
  1743. '               LOCAL.USER
  1744. '               MODEM.STATUS.REGISTER
  1745. '               NUM.RETURNS
  1746. '               RETURN.LINE.FEED$
  1747. '               SNOOP
  1748. '
  1749. '  OUTPUTS -- NONE
  1750. '
  1751. '  PURPOSE -- Skip lines on the user's terminal
  1752. '
  1753.       SUB SKIPLINE (NUM.RETURNS) STATIC
  1754.       FOR I=1 TO NUM.RETURNS
  1755.           CALL PUTCOM (RETURN.LINE.FEED$)
  1756.       NEXT
  1757.       IF NOT SNOOP THEN _
  1758.          GOTO 1486
  1759.       IF USE.BASIC.WRITES THEN _
  1760.          FOR I = 1 TO NUM.RETURNS : _
  1761.             PRINT : _
  1762.          NEXT : _
  1763.       ELSE FOR I = 1 TO NUM.RETURNS : _
  1764.               LOCATE ,,1 : _
  1765.               CALL ANSI(CRLF$,C.L,C.C) : _
  1766.               LOCATE C.L,C.C : _
  1767.               NEXT
  1768. 1486  LINES.PRINTED = LINES.PRINTED + NUM.RETURNS
  1769.       UNIT.COUNT = UNIT.COUNT - DISPLAY.AS.UNIT * NUM.RETURNS
  1770.       END SUB
  1771. 1496 ' $SUBTITLE: 'SETCRLF -- sub to set up nulls/lf's for output'
  1772. ' $PAGE
  1773. '
  1774. '  NAME    -- SETCRLF
  1775. '
  1776. '  INPUTS  --   PARAMETER          MEANING
  1777. '              CARRIAGE.RETURN$    CARRIAGE RETURN CHARACTER
  1778. '              LINE.FEED$          LINE FEED CHARACTER
  1779. '              LINE.FEEDS          LINE FEED SWITCH
  1780. '              NUL$                NULL CHARACTER
  1781. '
  1782. '  OUTPUTS -- RETURN.LINE.FEED$   END-OF-LINE STRING
  1783. '
  1784. '  PURPOSE -- Set up the necessary nulls/line feeds to end
  1785. '             each output to the communications port with.
  1786. '
  1787.       SUB SETCRLF STATIC
  1788.       RETURN.LINE.FEED$ = _
  1789.          MID$(CARRIAGE.RETURN$,1, - (NOT LOCAL.USER)) + _
  1790.          NUL$ + _
  1791.          MID$(LINE.FEED$,1, - (LINE.FEEDS <> 0))
  1792.       END SUB
  1793. 1498 ' $SUBTITLE: 'TGET -- ask a user a question and get reply'
  1794. ' $PAGE
  1795. '
  1796. '  NAME    -- TGET
  1797. '
  1798. '  INPUTS  --    PARAMETER                   MEANING
  1799. '             SUBROUTINE.PARAMETER = 1  STANDARD ENTRY
  1800. '                                  = 2  ENTRY AFTER A FUNCTION KEY   ' KG081201
  1801. '                                         HAS BEEN HANDLED           ' KG081201
  1802. '                                  = 3  ENTRY AFTER STACKED COMMAND  ' KG081201
  1803. '             A$                        STRING TO WRITE TO THE
  1804. '                                       COMMUNICATIONS PORT
  1805. '             HIDDEN                    IF THIS IS TRUE THEN ECHO
  1806. '                                       '.' INSTEAD OF ACTUAL
  1807. '                                       CHARACTER ENTERED.
  1808. '             FORCE.KEYBOARD            IF TRUE, STACKED INPUT
  1809. '                                       IS BYPASSED AND KEYBOARD
  1810. '                                       INPUT IS READ.
  1811. '
  1812. '  OUTPUTS -- SUBROUTINE.PARAMETER = -1 CARRIER HAS BEEN DROPPED
  1813. '             B$                        STRING THAT WAS ENTERED
  1814. '             Q                         NUMBER OF PARAMETERES THAT
  1815. '                                       WERE ENTERED WHICH WHERE
  1816. '                                       SEPARATED BY A SEMICOLON
  1817. '             B$()                      STRING MATRIX WITH EACH
  1818. '                                       ITEM CONTAIN THE STRING
  1819. '                                       THAT WAS ENTERED BETWEEN
  1820. '                                       SEMICOLONS.
  1821. '             FUNCTION.KEY        <>  0 FUNCTION KEY PRESSED
  1822. '             YES                       REPLY IS "Y" OR "YES"
  1823. '             NO                        REPLY IS "N" OR "NO"
  1824. '             NON.STOP                  REPLY IS "NS" OR "ns"
  1825. '             KILL.MESSAGE              REPLY IS "K"
  1826. '             REPLY                     REPLY IS "RE"
  1827. '
  1828. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1829. '
  1830.       SUB TGET STATIC
  1831.       ON SUBROUTINE.PARAMETER GOTO 1500,1538,1625                    ' KG081201
  1832. '
  1833. '
  1834. ' *  COMMON INPUT ROUTINE
  1835. '
  1836. '
  1837. 1500 CALL CARRIER
  1838.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1839.         EXIT SUB                                                     ' KG061203
  1840.      LINES.PRINTED = 0
  1841.      DISPLAY.AS.UNIT = FALSE
  1842.      IN.STACK = FALSE
  1843.      TOA! = FRE("A")
  1844.      GOSUB 1580                                                      ' KG071906
  1845.      A = 0
  1846.      B = 0
  1847.      C = 0
  1848.      Q = 1
  1849.      STORE.PARSE.AT = 1                                              ' KG083101
  1850.      PARM = 0
  1851.      YES = FALSE
  1852.      B$ = ""
  1853.      SLEEP.WARN = TRUE
  1854.      NO = FALSE
  1855.      NON.STOP = (PAGE.LENGTH < 1)                                    ' KG072603
  1856.      IF A$ = "" THEN _
  1857.         GOTO 1525
  1858.      CALL COLORPMT (A$)
  1859.      A$ = A$ + _
  1860.           MID$("? !  ",2*TURBO.KEY+1,2)
  1861.      SUBROUTINE.PARAMETER = 4
  1862.      STOP.SAVE = STOP.INTERRUPTS
  1863.      STOP.INTERRUPTS = TRUE
  1864.      CALL TPUT
  1865.      STOP.INTERRUPTS = STOP.SAVE
  1866.      IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1867.         EXIT SUB
  1868. 1523 IF PROMPT.BELL THEN _
  1869.         IF LOCAL.USER THEN _
  1870.            BEEP_
  1871.         ELSE CALL PUTCOM(BELL.RINGER$)
  1872. 1525 CALL CARRIER
  1873.      IF SUBROUTINE.PARAMETER = -1 THEN _
  1874.         EXIT SUB
  1875.      IF LEN(COMMPORT.STACK$) > 0 THEN _                              ' KG072602
  1876.         IN.STACK = TRUE : _
  1877.         X = INSTR(COMMPORT.STACK$,CARRIAGE.RETURN$) : _
  1878.         IF X > 0 THEN _
  1879.            A$ = LEFT$(COMMPORT.STACK$,X-1) : _
  1880.            COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-X) : _
  1881.            GOTO 1534 _
  1882.         ELSE Y$ = LEFT$(COMMPORT.STACK$,1) : _
  1883.              COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  1884.              GOTO 1541
  1885.      IF (FORCE.KEYBOARD OR (NOT MACRO.ACTIVE) OR (MACRO.SAVE > 0)) THEN _
  1886.         GOTO 1536
  1887. '
  1888. ' *** MACRO PROCESSING
  1889. '
  1890. 1526 CALL READMACRO
  1891.      IF (DISTANT.TGET > 0 ) OR (MACRO.TEMPLATE$ <> "") OR (MACRO.SAVE > 0) OR (NOT MACRO.ACTIVE) THEN _
  1892.         GOTO 1536
  1893. 1534 B$ = A$   ' Not Macro command - pass to normal processing
  1894.      IF MACRO.ECHO THEN _
  1895.         SUBROUTINE.PARAMETER = 4 : _
  1896.         CALL TPUT
  1897.      Y$ = CARRIAGE.RETURN$
  1898.      GOTO 1547
  1899. 1536 IF LOCAL.USER THEN _
  1900.         CALL FINDFUNC: _
  1901.         IF SUBROUTINE.PARAMETER < 0 THEN _
  1902.            EXIT SUB _
  1903.         ELSE GOTO 1538
  1904.      CALL EOFCOMM (CHAR%)
  1905.      IF CHAR% <> -1 THEN _
  1906.         CALL GETCOM(Y$) : _
  1907.         IF SUBROUTINE.PARAMETER = -1 THEN _
  1908.            EXIT SUB _
  1909.         ELSE GOTO 1541
  1910.      CALL FINDTIME (TI!)
  1911.      IF TI! > AUTO.WARN! THEN _
  1912.         IF TI! > AUTO.LOGOFF! THEN _
  1913.            CALL UPDTCALR ("Sleep disconnect",1) : _
  1914.            SUBROUTINE.PARAMETER = -1 : _
  1915.            EXIT SUB _
  1916.         ELSE IF SLEEP.WARN THEN _
  1917.                 SLEEP.WARN = FALSE : _
  1918.                 A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _
  1919.                 CALL RINGCALLER
  1920.      CALL FINDFUNC
  1921.      IF SUBROUTINE.PARAMETER < 0 THEN _
  1922.         EXIT SUB
  1923. 1538 Y$ = KEY.PRESSED$
  1924.      IF Y$ <> "" THEN _
  1925.         GOTO 1545
  1926.      SEND.REMOTE = TRUE
  1927.      CALL GOIDLE
  1928.      GOTO 1525
  1929. 1541 SEND.REMOTE = REMOTE.ECHO
  1930.      IF TEST.PARITY THEN _
  1931.         GOTO 1542
  1932.      IF Y$ = CHR$(127) THEN _
  1933.         GOTO 1635
  1934.      GOTO 1545
  1935. 1542 IF Y$ = "" THEN _
  1936.         Y$ = " "
  1937.      IF ASC(Y$) = 141 THEN _
  1938.         OUT LINE.CONTROL.REGISTER,&H1A : _
  1939.         EIGHT.BIT = FALSE : _
  1940.         TEST.PARITY = FALSE : _
  1941.         GR = FALSE
  1942.      Y$ = CHR$(ASC(Y$) AND 127)
  1943. 1545 X$ = Y$
  1944.      IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  1945.         GOTO 1635
  1946.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  1947.         GOTO 1525
  1948.      IF Y$ = "^" THEN _
  1949.         GOTO 1525
  1950.      IF Y$ = CARRIAGE.RETURN$ THEN _
  1951.         GOTO 1547 _
  1952.      ELSE GOSUB 1550
  1953.      IF TURBO.KEY < 1 THEN _
  1954.         GOTO 1546
  1955.      IF Y$ = " " THEN _
  1956.         Y$ = ""
  1957.      IF Y$ <> "/" THEN _
  1958.         B$ = Y$ : _
  1959.         Y$ = CARRIAGE.RETURN$ : _
  1960.         X$ = Y$ : _
  1961.         GOTO 1547
  1962.      TURBO.KEY = 0
  1963.      GOTO 1525
  1964. 1546 IF LEN(B$) => 512 THEN _
  1965.         A$ = "Input too long!" : _
  1966.         SUBROUTINE.PARAMETER = 5 : _
  1967.         CALL TPUT : _
  1968.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  1969.            EXIT SUB _
  1970.         ELSE GOTO 1500
  1971.      B$ = B$ + _
  1972.           Y$
  1973.      GOTO 1525
  1974. 1547 TURBO.KEY = FALSE          ' Carriage Return Handler
  1975.      HIDDEN = FALSE
  1976.      IF NO.ADVANCE THEN _
  1977.         NO.ADVANCE = FALSE : _
  1978.         GOTO 1575 _
  1979.      ELSE CALL LPRNT (CRLF$,0) : _
  1980.           GOSUB 1551 : _
  1981.           GOTO 1570
  1982. 1550 IF LOGON.ACTIVE THEN _
  1983.         IF (Y$ = " " OR Y$ = ";") AND _
  1984.            RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _
  1985.               PARM = PARM + 1 : _
  1986.               LOGON.ACTIVE = (PARM < 3) : _
  1987.               HIDDEN = (PARM = 2) : _
  1988.               CALL LPRNT(X$,0) : _
  1989.               GOTO 1551
  1990.      IF HIDDEN THEN _
  1991.         X$ = "."
  1992.      CALL LPRNT(X$,0)
  1993. 1551 IF NOT SEND.REMOTE THEN _
  1994.         RETURN
  1995.      IF HIDDEN THEN _
  1996.         X$ = "."
  1997. 1553 CALL PUTCOM (X$)
  1998.      RETURN
  1999. 1570 IF SEND.REMOTE THEN _
  2000.         IF LINE.FEEDS THEN _
  2001.            CALL PUTCOM (LINE.FEED$)
  2002. 1575 IF LEN(B$) > 4000 THEN _
  2003.         A$ = "Try again, " + _
  2004.              FIRST.NAME$ : _
  2005.         SUBROUTINE.PARAMETER = 5 : _
  2006.         CALL TPUT : _
  2007.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  2008.            EXIT SUB _
  2009.         ELSE GOTO 1500
  2010.      IF PARSE.OFF THEN _
  2011.         PARSE.OFF = FALSE : _
  2012.         GOTO 1620
  2013.      CALL PARSEIT
  2014.      IF Q = 1 THEN _
  2015.         GOTO 1622
  2016.      GOTO 1625
  2017. 1580 CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)            ' KG071905
  2018.      AUTO.WARN! = AUTO.LOGOFF! - 30                                  ' KG071905
  2019.      RETURN                                                          ' KG071905
  2020. 1620 B$(1) = B$
  2021.      Q = 1
  2022. 1622 IF B$ = "" THEN _
  2023.         Q = 0 : _
  2024.         HIDDEN = FALSE : _
  2025.         GOTO 1628
  2026. 1625 IF LEN(B$) < 4 THEN _
  2027.         X$ = LEFT$(B$,3): _
  2028.         CALL ALLCAPS (X$) : _
  2029.         IF X$ = "Y" OR X$ = "YES" THEN _
  2030.            YES = TRUE _
  2031.         ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _
  2032.                 NO = TRUE _
  2033.              ELSE IF X$ = "RE" THEN _
  2034.                      REPLY = TRUE : _
  2035.                      GOTO 1628 _
  2036.                   ELSE IF X$ = "K" THEN _
  2037.                           KILL.MESSAGE = TRUE : _
  2038.                           GOTO 1628                                  ' KG090101
  2039.      HIDDEN = FALSE
  2040. 1628 FORCE.KEYBOARD = FALSE                                          ' KG090101
  2041.      IF MACRO.SAVE > 0 THEN _                                        ' KG090101
  2042.         GSR.ARA$(MACRO.SAVE) = B$ : _
  2043.         MACRO.SAVE = 0 : _
  2044.         GOTO 1632                                                    ' KG071905
  2045.      IF (DISTANT.TGET > 0) OR (MACRO.TEMPLATE$ <> "") THEN _
  2046.         CALL WIPELINE (38) : _
  2047.         IF NOT NO THEN _
  2048.            GOTO 1632 _                                               ' KG071905
  2049.         ELSE Q = 0 : _
  2050.              MACRO.TEMPLATE$ = "" : _
  2051.              DISTANT.TGET = 0 : _
  2052.              NO = FALSE : _                                          ' KG061001
  2053.              GOTO 1633                                               ' KG071905
  2054.      IF MACRO.ACTIVE OR ((NOT IN.STACK) AND INSTR(B$,".") > 0) THEN _ ' KG060189
  2055.         EXIT SUB
  2056.      CALL NOPATH (B$(ANS.INDEX),FOUND)                               ' KG083101
  2057.      IF FOUND THEN _                                                 ' KG060801
  2058.         EXIT SUB                                                     ' KG060801
  2059.      CALL CHKMACRO (B$(ANS.INDEX),FOUND)                             ' KG083101
  2060.      IF FOUND THEN _
  2061.         STORE.PARSE.AT = ANS.INDEX : _                               ' KG083101
  2062.         GOTO 1525
  2063.      EXIT SUB
  2064. 1632 B$ = ""                                                         ' KG071905
  2065.      FORCE.KEYBOARD = FALSE                                          ' KG071905
  2066. 1633 GOSUB 1580                                                      ' KG071906
  2067.      Q = 1                                                           ' KG072601
  2068.      GOTO 1525                                                       ' KG071905
  2069. 1635 IF LEN(B$) = 0 THEN _
  2070.         GOTO 1525
  2071.      IF LOGON.ACTIVE THEN _
  2072.         IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _
  2073.            PARM = PARM - 1
  2074.      B$ = LEFT$(B$,LEN(B$)-1)
  2075.      CALL LPRNT(LOCAL.BACKSPACE$,0)
  2076.      IF SEND.REMOTE THEN _
  2077.         CALL PUTCOM(BACKSPACE$)
  2078.      GOTO 1525
  2079.      END SUB
  2080. 1636 ' $SUBTITLE: 'RINGCALLER - sub to use sound + screen emphasis'
  2081. ' $PAGE
  2082. '
  2083. '  NAME    -- RINGCALLER
  2084. '
  2085. '  INPUTS  --     PARAMETER                    MEANING
  2086. '                 A$                           STRING TO EMPHASIZE
  2087. '
  2088. '  OUTPUTS --  none
  2089. '
  2090. '  PURPOSE --  Rings the users bell before and after string
  2091. '              (but not snooping sysop) and adds emphasis around
  2092. '              message sent.
  2093. '
  2094.      SUB RINGCALLER STATIC
  2095.      X$ = LEFT$(BELL.RINGER$,-LOCAL.USER)
  2096.      CALL PUTCOM (BELL.RINGER$)
  2097.      CALL LPRNT (X$,0)
  2098.      SUBROUTINE.PARAMETER = 2
  2099.      A$ = EMPHASIZE.ON$ + A$ + EMPHASIZE.OFF$
  2100.      CALL TPUT
  2101.      CALL PUTCOM (BELL.RINGER$)
  2102.      CALL LPRNT (X$,0)
  2103.      END SUB
  2104. 1637 ' $SUBTITLE: 'PARSEIT - subroutine to parse a string'
  2105. ' $PAGE
  2106. '
  2107. '  NAME    -- PARSEIT
  2108. '
  2109. '  INPUTS  --     PARAMETER                    MEANING
  2110. '                 B$                           STRING TO PARSE
  2111. '
  2112. '  OUTPUTS --  Q                            NUMBER PARSED
  2113. '              B$()                         PARSED STRINGS
  2114. '
  2115. '  PURPOSE --  To parse a string into pieces.  Uses semicolon
  2116. '              if exists, otherwise space, otherwise comma           ' KG083103
  2117. '
  2118.      SUB PARSEIT STATIC
  2119.      A = INSTR(B$,";")
  2120.      IF A > 0 THEN _
  2121.         PARSE.CHAR$ = ";" _
  2122.      ELSE IF B$ <> SPACE$(LEN(B$)) THEN _
  2123.              CALL TRIM (B$) : _
  2124.              X$ = B$ : _                                             ' KG060302
  2125.              A = INSTR(B$,"  ") : _
  2126.              WHILE A > 0 : _
  2127.                 B$ = LEFT$(B$,A - 1) + _
  2128.                      MID$(B$,A + 1) : _
  2129.                 A = INSTR(A,B$,"  ") : _
  2130.              WEND : _
  2131.              A = INSTR(B$," ") : _
  2132.              IF A > 1 THEN _
  2133.                 PARSE.CHAR$ = " " _
  2134.              ELSE A = INSTR(B$,",") : _
  2135.                   PARSE.CHAR$ = ","
  2136.      IF A < 2 THEN _
  2137.         B$(STORE.PARSE.AT) = B$ : _                                  ' KG083101
  2138.         DF$ = B$ : _                                                 ' KG071903
  2139.         CALL ALLCAPS (DF$) : _                                       ' KG071903
  2140.         NON.STOP = NON.STOP OR (DF$ = "C") : _                       ' KG071903
  2141.         EXIT SUB
  2142.      B$(STORE.PARSE.AT) = LEFT$(B$,A - 1)                            ' KG083101
  2143.      A = A + 1
  2144.      EOL = FALSE
  2145. 1640 B = INSTR(A,B$,PARSE.CHAR$)
  2146.      C = B-A
  2147.      IF C < 1 THEN _
  2148.         EOL = TRUE : _
  2149.         C = 128
  2150.      DF$ = MID$(B$,A,C)
  2151.      IF DF$ <> "" THEN _
  2152.         Q = Q + 1 : _
  2153.         STORE.PARSE.AT = STORE.PARSE.AT + 1 : _                      ' KG083101
  2154.         B$(STORE.PARSE.AT) = DF$ : _                                 ' KG083101
  2155.         CALL ALLCAPS(DF$) : _
  2156.         X = INSTR("NS;/G;C;",DF$+";") : _                            ' KG072402
  2157.         IF X > 0 THEN _
  2158.            IF LEN(DF$) = 2 THEN _
  2159.               Q = Q - 1 : _
  2160.               STORE.PARSE.AT = STORE.PARSE.AT - 1 : _                ' KG083101
  2161.               NON.STOP = NON.STOP OR (X = 1) : _
  2162.               AUTO.LOGOFF = AUTO.LOGOFF OR (X = 4) _
  2163.            ELSE IF LEN(DF$) = 1 THEN _                               ' KG071903
  2164.                    NON.STOP = NON.STOP OR (X = 7)                    ' KG071903
  2165.      IF NOT EOL AND Q < 50 THEN _
  2166.         A = B + 1 : _
  2167.         GOTO 1640
  2168.      IF PARSE.CHAR$ <> ";" THEN _                                    ' KG060302
  2169.         B$ = X$                                                      ' KG060302
  2170.      END SUB
  2171. 1650 ' $SUBTITLE: 'POPCSTACK - prompt for value with command stack check ' KG081201
  2172.      SUB POPCSTACK STATIC
  2173.      CALL CHKCARRIER                                                 ' KG082603
  2174.      IF SUBROUTINE.PARAMETER = -1 THEN _                             ' KG081201
  2175.         LAST.INDEX = 0 : _                                           ' KG081201
  2176.         Q = 0 : _                                                    ' KG081201
  2177.         EXIT SUB                                                     ' KG081201
  2178.      Q = 1                                                           ' KG081201
  2179.      IF ANS.INDEX < LAST.INDEX THEN _                                ' KG081201
  2180.         ANS.INDEX = ANS.INDEX + 1 : _                                ' KG081201
  2181.         B$ = B$(ANS.INDEX) : _                                       ' KG081201
  2182.         SUBROUTINE.PARAMETER = 3 : _                                 ' KG081201
  2183.         CALL TGET : _                                                ' KG081201
  2184.         EXIT SUB                                                     ' KG081201
  2185.      LAST.INDEX = 0                                                  ' KG081201
  2186.      ANS.INDEX = 1                                                   ' KG081201
  2187.      SUBROUTINE.PARAMETER = 1                                        ' KG081201
  2188.      SEARCHING.ALL = FALSE                                           ' KG081201
  2189.      CALL TGET                                                       ' KG081201
  2190.      LAST.INDEX = Q                                                  ' KG081201
  2191.      END SUB                                                         ' KG081201
  2192. 1654 ' $SUBTITLE: 'SETBAUD - sub to set the baud rate in the RS232'
  2193. ' $PAGE
  2194. '
  2195. '  NAME    -- SETBAUD
  2196. '
  2197. '  INPUTS  --     PARAMETER                    MEANING
  2198. '             BAUD.RATE.DIVISOR   NUMBER TO DIVIDE THE 8250 CHIP'S
  2199. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  2200. '                                 BAUD RATE TO THE USER'S BAUD
  2201. '                                 RATE (INDEPENDENT OF THE BAUD
  2202. '                                 RATE USED TO OPEN THE COMM. PORT)
  2203. '
  2204. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2205. '            RATE              PCjr         PC AND XT
  2206. '              50             2237             2304
  2207. '              75             1491             1536
  2208. '             110             1017             1047
  2209. '             134.5            832              857
  2210. '             150              746              768
  2211. '             300              373              384
  2212. '             600              186              192
  2213. '            1200               93               96
  2214. '            1800               62               64
  2215. '            2000               56               58
  2216. '            2400               47               48
  2217. '            3600               31               32
  2218. '            4800               23               24
  2219. '            7200          not available         16
  2220. '            9600          not available         12
  2221. '           19200          not available          6
  2222. '           38400               "                 3                  ' KG090102
  2223. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  2224. '
  2225. '  PURPOSE -- To set the baud rate in the RS232 interface
  2226. '             inpependent of the baud rate the communications port
  2227. '             was opened at
  2228. '
  2229.       SUB SETBAUD STATIC
  2230. IF KEEP.INIT.BAUD > -1 THEN _                                   ' WM042201
  2231.   IF KEEP.INIT.BAUD = 0 OR BPS > -5 THEN _                     ' WM042201
  2232.   TALK.TO.MODEM.AT$ =  MID$("      300  450 1200 2400 4800 96001920038400", _ ' Pe 09/05/89
  2233.   (-5 * BPS),5) _                  ' WM042201
  2234.      ELSE TALK.TO.MODEM.AT$ = MODEM.INIT.BAUD$
  2235.      CALL TRIM (TALK.TO.MODEM.AT$)
  2236.      IF LEN(TALK.TO.MODEM.AT$) < 5 THEN _
  2237.         TALK.TO.MODEM.AT$ = SPACE$(4 - LEN(TALK.TO.MODEM.AT$)) + _
  2238.                             TALK.TO.MODEM.AT$
  2239.      IF EIGHT.BIT THEN_
  2240.         PARITY% = 2 : _                                    ' NO PARITY
  2241.         DATABITS% = 3 : _                                  ' 8 DATA BITS
  2242.         STOPBITS% = 0 _                                    ' 1 STOP BIT
  2243.      ELSE PARITY% = 3 : _                                  ' EVEN PARITY
  2244.           DATABITS% = 2 : _                                ' 7 DATA BITS
  2245.           STOPBITS% = 0                                    ' 1 STOP BIT
  2246.      COMSPEED! = VAL(TALK.TO.MODEM.AT$)                              ' KG090102
  2247.      IF COMSPEED! > 19200 THEN _                                     ' KG090102
  2248.         I = 19200 _                                                  ' KG090102
  2249.      ELSE I = COMSPEED!                                              ' KG090102
  2250.      IF FOSSIL THEN _
  2251.         CALL FOSSPEED(COMPORT%,I,PARITY%,DATABITS%,STOPBITS%) : _    ' KG090102
  2252.         EXIT SUB
  2253.      IF COMSPEED! = 2400 THEN _                                      ' KG090102
  2254.         BAUD.RATE.DIVISOR = &H30 + (1 * (COMPUTER.TYPE = 2)) _       ' KG090102
  2255.      ELSE IF COMSPEED! = 1200 THEN _                                 ' KG090102
  2256.         BAUD.RATE.DIVISOR = &H60 + (3 * (COMPUTER.TYPE = 2)) _       ' KG090102
  2257.      ELSE IF COMSPEED! = 9600 THEN _                                 ' KG090102
  2258.         BAUD.RATE.DIVISOR = &HC _                                    ' KG090102
  2259.      ELSE IF COMSPEED! = 300 THEN _                                  ' KG090102
  2260.         BAUD.RATE.DIVISOR = &H180 + (11 * (COMPUTER.TYPE = 2)) _     ' KG090102
  2261.      ELSE IF COMSPEED! = 450 THEN _                                  ' KG090102
  2262.         BAUD.RATE.DIVISOR = &H100 + (8 * (COMPUTER.TYPE = 2)) _      ' KG090102
  2263.      ELSE IF COMSPEED! = 4800 THEN _                                 ' KG090102
  2264.         BAUD.RATE.DIVISOR = &H18 _                                   ' KG090102
  2265.      ELSE IF COMSPEED! = 19200 THEN _                                ' KG090102
  2266.         BAUD.RATE.DIVISOR = &H6 _                                    ' KG090102
  2267.      ELSE IF COMSPEED! = 38400 THEN _                                ' KG090102
  2268.         BAUD.RATE.DIVISOR = &H3                                      ' KG090102
  2269.      MOST.SIGNIFICANT.BYTE = FIX (BAUD.RATE.DIVISOR / 256)
  2270.      LEAST.SIGNIFICANT.BYTE = BAUD.RATE.DIVISOR - (MOST.SIGNIFICANT.BYTE * 256)
  2271.      LINE.CONTROL.STATUS = INP(LINE.CONTROL.REGISTER)
  2272.      MSB.SAVE = INP(MSB)
  2273.      OUT MSB,0
  2274.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS OR 128
  2275.      OUT LSB,LEAST.SIGNIFICANT.BYTE
  2276.      OUT MSB,MOST.SIGNIFICANT.BYTE
  2277.      OUT LINE.CONTROL.REGISTER,LINE.CONTROL.STATUS
  2278.      OUT MSB,MSB.SAVE
  2279.      END SUB
  2280. 2018 ' $SUBTITLE: 'MSGTO - subroutine to get who a message is to'
  2281. ' $PAGE
  2282. '
  2283. '  NAME    -- MSGTO
  2284. '
  2285. '  INPUTS  --     PARAMETER                    MEANING
  2286. '              HIGHEST.USER.RECORD
  2287. '
  2288. '  OUTPUTS --  MESSAGE.TO$              Who message is to
  2289. '              RECEIVER.REC.NUM         User record # of who to
  2290. '
  2291. '  PURPOSE --  Asks who a message is to and determines if receiver exists
  2292. '
  2293.      SUB MSGTO (HIGHEST.USER.RECORD,MESSAGE.TO$,RECEIVER.REC.NUM,FOUND) STATIC
  2294. 2020 IF MESSAGE.TO$ <> "" THEN _
  2295.         GOTO 2032
  2296.      A$ = "To [A]ll,S)ysop, or name"
  2297.      CALL SKIPLINE (1)
  2298.      PARSE.OFF = TRUE                                                ' KG082602
  2299.      CALL POPCSTACK                                                  ' KG081201
  2300.      IF SUBROUTINE.PARAMETER < 0 THEN _                              ' KG081201
  2301.         EXIT SUB                                                     ' KGO81201
  2302.      IF LEN(B$) > 30 THEN _
  2303.         CALL QTPUT1 (CX$(6) +"30 Char. Max" +CX$(7)) : _
  2304.         GOTO 2020
  2305. 2030 FOUND = TRUE
  2306.      IF Q = 0 THEN _
  2307.         MESSAGE.TO$ = "ALL" _
  2308.      ELSE CALL ALLCAPS (B$) : _
  2309.           IF B$ = "A" THEN _
  2310.              MESSAGE.TO$ = "ALL" : _
  2311.              EXIT SUB _
  2312.           ELSE IF B$ = "S" THEN _
  2313.              MESSAGE.TO$ = "SYSOP" _
  2314.           ELSE MESSAGE.TO$ = B$
  2315. 2032 IF MESSAGE.TO$ <> "ALL" THEN _
  2316.         IF (LEFT$(MESSAGE.TO$,4) <> "ALL " AND START.HASH = 1) THEN _ ' KP061602
  2317.            TEMP.HASH.VALUE$ = MESSAGE.TO$ : _
  2318.            CALL WHOCHECK (TEMP.HASH.VALUE$,FOUND,RECEIVER.REC.NUM) : _
  2319.            IF NOT FOUND THEN _
  2320.               LAST.INDEX = 0 : _                                     ' KGO81201
  2321.               RECEIVER.REC.NUM = 0 : _
  2322.               A$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2323.               TURBO.KEY = -TURBO.KEY.USER : _
  2324.               GOSUB 2033 : _
  2325.               Z$ = B$(1) : _
  2326.               CALL ALLCAPS (Z$) : _
  2327.               IF Z$ <> "C" THEN _
  2328.                  MESSAGE.TO$ = "" : _
  2329.                  IF Z$ <> "Q" THEN _
  2330.                     GOTO 2020
  2331.      EXIT SUB
  2332. 2033 SUBROUTINE.PARAMETER = 1
  2333.      CALL TGET
  2334.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2335.         EXIT SUB
  2336.      RETURN
  2337.      END SUB
  2338. 2055 ' $SUBTITLE: 'MSGPROT - gets protection wanted for a message'
  2339. ' $PAGE
  2340. '
  2341. '  NAME    -- MSGPROT
  2342. '
  2343. '  INPUTS  --     PARAMETER                    MEANING
  2344. '                 MESSAGE.TO$
  2345. '                 FOUND
  2346. '
  2347. '  OUTPUTS --  PASSWORD$                Protection desired
  2348. '
  2349. '  PURPOSE --  Sets protection desired for a new message
  2350. '
  2351.      SUB MSGPROT (MESSAGE.TO$,FOUND,MESSAGE.PASSWORD$) STATIC
  2352.      IF MESSAGE.TO$ = "ALL" THEN _
  2353.         GOTO 2090
  2354. 2060 A$ = "Make message [P]ublic, p(R)ivate, (H)elp"
  2355.      TURBO.KEY = -TURBO.KEY.USER                                     ' KG081201
  2356.      GOSUB 2096                                                      ' KG081201
  2357.      IF Q = 0 THEN _
  2358.         B$(ANS.INDEX) = "P"
  2359.      Z$ = LEFT$(B$(ANS.INDEX),1)                                     ' KG081201
  2360.      CALL ALLCAPS (Z$)
  2361.      ON INSTR("RPUH",Z$) GOTO 2075,2090,2075,2070
  2362.      GOTO 2060
  2363. '
  2364. ' **  DISPLAY MESSAGE PROTECT HELP   *
  2365. '
  2366. 2070 CALL BUFFILE (HELP$(3),X)
  2367.      GOTO 2060
  2368. '
  2369. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
  2370. '
  2371. 2075 IF MESSAGE.TO$ = "ALL" THEN _
  2372.         CALL QTPUT1 ("Msg to ALL cannot be private") : _
  2373.         GOTO 2060
  2374.      IF Z$ = "U" THEN _
  2375.         GOTO 2088
  2376. 2081 CALL QTPUT1 ("Sending personal mail to " + MESSAGE.TO$)
  2377. 2084 MESSAGE.PASSWORD$ = "^READ^"
  2378.      EXIT SUB
  2379. 2085 A$ = "Password"
  2380.      GOSUB 2096                                                      ' KG081201
  2381.      IF Q = 0 THEN _
  2382.         GOTO 2085
  2383.      IF LEN(B$) > L THEN _
  2384.         CALL QTPUT1 (STR$(L) + " Chars. max") : _
  2385.         GOTO 2085
  2386.      IF L = 15 AND LEFT$(B$,1) = "!" THEN _
  2387.         CALL QTPUT1 ("Password can't begin with '!'") : _
  2388.         GOTO 2085
  2389.      RETURN
  2390. '
  2391. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
  2392. '
  2393. 2088 A$ = "Receiver(s) Must KNOW PASSWORD TO READ msg.  Use password (Y/[N])"
  2394.      GOSUB 2093
  2395.      IF NOT YES THEN _
  2396.         GOTO 2070
  2397.      L = 14
  2398.      A1$ = "!"
  2399.      GOSUB 2085
  2400.      CALL ALLCAPS (B$)
  2401.      GOTO 2092
  2402. '
  2403. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  2404. '
  2405. 2090 L = 15
  2406.      A1$ = ""
  2407.      B$ = "^KILL^"
  2408. 2092 MESSAGE.PASSWORD$ = A1$ + _
  2409.                          B$
  2410.      EXIT SUB
  2411. 2093 TURBO.KEY = -TURBO.KEY.USER
  2412. 2094 SUBROUTINE.PARAMETER = 1
  2413.      CALL TGET
  2414. 2095 IF SUBROUTINE.PARAMETER = -1 THEN _                             ' KG081201
  2415.         EXIT SUB
  2416.      RETURN
  2417. 2096 CALL POPCSTACK                                                  ' KG081201
  2418.      GOTO 2095                                                       ' KG081201
  2419.      END SUB
  2420. 2250 ' $SUBTITLE: 'WHOCHECK - Checks whether user exists'
  2421. ' $PAGE
  2422. '
  2423. '  NAME    -- WHOCHECK
  2424. '
  2425. '  INPUTS  --   PARAMETER                    MEANING
  2426. '              WHO.FIND$                User to find
  2427. '
  2428. '  OUTPUTS --  WHO.FOUND                Whether user found
  2429. '              USER.NUM.FOUND           Record # of user
  2430. '
  2431. '  PURPOSE --  Validate that user record exists.  Sysop
  2432. '              counted as found even if lack user record.
  2433. '
  2434.      SUB WHOCHECK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC
  2435.      USER.NUM.FOUND = 0
  2436.      IF START.HASH <> 1 THEN _
  2437.         WHO.FOUND = TRUE : _
  2438.         EXIT SUB
  2439.      WORK.128$ = USER.RECORD$                                        ' KG080401
  2440.      WHO.FOUND = FALSE
  2441.      TO.SYSOP = (INSTR(WHO.FIND$,"SYSOP") > 0 OR _
  2442.                  INSTR(WHO.FIND$,SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$) > 0 )
  2443.      CALL OPENUSER (HIGHEST.USER.RECORD)
  2444.      FIELD 5, 128 AS USER.RECORD$
  2445.      IF TO.SYSOP THEN _
  2446.         X$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _
  2447.      ELSE X$ = WHO.FIND$
  2448.      IF LEN(X$) > 1 THEN _                                           ' KG073001
  2449.         CALL FINDUSER (X$,"",START.HASH,LEN.HASH,_                   ' KG073001
  2450.                        0,0,HIGHEST.USER.RECORD,WHO.FOUND,_
  2451.                        USER.NUM.FOUND,SL)
  2452.      LSET USER.RECORD$ = WORK.128$                                   ' KG080401
  2453. '     IF NOT WHO.FOUND THEN _
  2454. '        IF TO.SYSOP THEN _
  2455. '           WHO.FOUND = TRUE _
  2456. '        ELSE CALL QTPUT1 (WHO.FIND$ + " not active user")
  2457. '****** ALIAS Changes next *************
  2458.      IF NOT WHO.FOUND THEN _
  2459.         IF TO.SYSOP THEN _
  2460.        WHO.FOUND = TRUE _
  2461.     ELSE CALL ALIASCHK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) : _  'DGS-ALSMN
  2462.          IF NOT WHO.FOUND THEN _                                 'DGS-ALSMN
  2463.         CALL QTPUT (WHO.FIND$ + " not active user",1)        'DGS-MNMOD
  2464.      END SUB
  2465. ' $SUBTITLE: 'ALIASCHK - Checks whether ALIAS exists'
  2466. ' $PAGE
  2467. '
  2468. '  SUBROUTINE NAME    -- ALIASCHK
  2469. '
  2470. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2471. '                         WHO.FIND$                ALIAS to find
  2472. '
  2473. '  OUTPUT PARAMETERS  --  WHO.FOUND                Whether ALIAS found
  2474. '                         USER.NUM.FOUND           Record # of User
  2475. '
  2476. '  SUBROUTINE PURPOSE --  Validate that ALIAS exists.  Get User Record
  2477. '
  2478. 2257 SUB ALIASCHK (WHO.FIND$,WHO.FOUND,USER.NUM.FOUND) STATIC        'DGS-ALSMN
  2479.      CALL BRKFNAME (MAIN.USER.FILE$,DRV$,PREFIX$,EXT$,TRUE)          '
  2480.      DGS.TEMP = INSTR(GRN$," ")                                      '
  2481.      IF DGS.TEMP > 0 THEN _                                          '
  2482.     DGS.FILE.NAME$ = DRV$ + LEFT$(GRN$,DGS.TEMP-1) + "A.DEF" _   '
  2483.      ELSE DGS.FILE.NAME$ = DRV$ + GRN$ + "A.DEF"                     '
  2484.      CALL FINDIT (DGS.FILE.NAME$)                                    '
  2485.      IF NOT OK THEN _                                                '
  2486.     EXIT SUB                                                     '
  2487.      OPEN "I", 7, DGS.FILE.NAME$                                     '
  2488.      DGS.ALIAS$ = ""                                                 '
  2489.      WHILE DGS.ALIAS$ = "" AND NOT EOF(7)                            '
  2490.     INPUT #7, DGS.USER.NAME$, DGS.TEMP.ALIAS$                    '
  2491.     IF DGS.TEMP.ALIAS$ = WHO.FIND$ THEN                          '
  2492.        DGS.ALIAS$ = DGS.USER.NAME$                               '
  2493.     END IF                                                       '
  2494.      WEND                                                            '
  2495.      CLOSE 7                                                         '
  2496. IF DGS.ALIAS$ = "" THEN _  'Pe 06/19/89
  2497. EXIT SUB                   'Pe 06/19/89
  2498.      CALL OPENUSER (HIGHEST.USER.RECORD)                             '
  2499.      FIELD 5, 128 AS USER.RECORD$                                    '
  2500.      CALL FINDUSER (DGS.USER.NAME$,TEMP.INDIV.VALUE$,START.HASH,LEN.HASH,_  '
  2501.             START.INDIV,LEN.INDIV,HIGHEST.USER.RECORD,WHO.FOUND,_   '
  2502.             USER.NUM.FOUND,SL)                                      '
  2503.      END SUB
  2504. 2618 ' $SUBTITLE: 'EDITALINE - Edits a line in a message'
  2505. ' $PAGE
  2506. '
  2507. '  NAME    -- EDITALINE
  2508. '
  2509. '  INPUTS  --     PARAMETER                    MEANING
  2510. '                 L                        Line # to edit
  2511. '
  2512. '  OUTPUTS --  A$(L)                    Edited line
  2513. '
  2514. '  PURPOSE --  Edit a line in a message.
  2515. '
  2516.      SUB EDITALINE (L) STATIC
  2517. 2620 A$ = "Line #" + _
  2518.           STR$(L) + _
  2519.           " is:" + _
  2520.           RETURN.LINE.FEED$ + _
  2521.           A$(L)
  2522.      SUBROUTINE.PARAMETER = 3
  2523.      CALL TPUT
  2524.      GOSUB 2695
  2525.      IF NOT EXPERT.USER THEN _
  2526.         CALL QTPUT1 ("Search & replace")
  2527.      A$ = "Search for" + _
  2528.           PRESS.ENTER.EXPERT$
  2529.      MACRO.MIN = 99
  2530.      PARSE.OFF = TRUE
  2531.      SUBROUTINE.PARAMETER = 1
  2532.      GOSUB 2694
  2533.      IF Q = 0 THEN _
  2534.         EXIT SUB
  2535.      Y$ = LEFT$(B$,1)
  2536.      IF Y$ = RIGHT$(B$,1) THEN _
  2537.         IF LEN(B$) > 2 THEN _
  2538.            X = INSTR(2,B$,Y$) : _
  2539.            IF X < LEN(B$) THEN _
  2540.               IF Y$ < "0" OR (Y$ > "9" AND Y$ < "A") THEN _
  2541.                  B$ = MID$(B$,2,LEN(B$)-2) : _
  2542.                  X = X - 1 : _
  2543.                  GOTO 2622
  2544.      X = INSTR(B$,";")
  2545. 2622 IF X > 0 THEN _
  2546.         X$ = LEFT$(B$,X-1) : _
  2547.         Y$ = RIGHT$(B$,LEN(B$)-X) : _
  2548.         GOTO 2660
  2549.      X$ = B$
  2550.      A$ = "And replace by"
  2551.      PARSE.OFF = TRUE
  2552.      SUBROUTINE.PARAMETER = 1
  2553.      GOSUB 2694
  2554.      Y$ = B$
  2555. 2660 X = INSTR(1,A$(L),X$)
  2556.      IF X = 0 THEN _
  2557.         CALL QTPUT1 ("<" + X$ + "> not found in line" + STR$(L)) : _
  2558.         GOTO 2620
  2559. 2670 FF = LEN(X$)
  2560.      JJ = LEN(Y$)
  2561.      IF FF = JJ THEN _
  2562.         MID$(A$(L),X) = Y$ : _
  2563.         GOTO 2620
  2564. 2690 DF$ = LEFT$(A$(L),X - 1)
  2565.      A$(L) = DF$ + _
  2566.              Y$ + _
  2567.              MID$(A$(L),X + FF)
  2568.      IF LEN(A$(L)) > RIGHT.MARGIN THEN _
  2569.         CALL WORDWRAP (RIGHT.MARGIN, LINES.IN.MESSAGE, A$())
  2570.      GOTO 2620
  2571. 2694 CALL TGET
  2572. 2695 IF SUBROUTINE.PARAMETER > -1 THEN _
  2573.         RETURN
  2574.      END SUB
  2575. 3700 ' $SUBTITLE: 'LINEEDIT  - subroutine to produce edited line'
  2576. ' $PAGE
  2577. '
  2578. '  NAME    -- LINEEDIT
  2579. '
  2580. '  INPUTS  -- PARAMETER             MEANING
  2581. '             BACK.ARROW$
  2582. '             BACKSPACE$
  2583. '             CARRIAGE.RETURN$
  2584. '             LINE.FEED$
  2585. '             LINEMES$          BUFFER SPACE TO USE FOR HOLDING LINE
  2586. '             LOCAL.USER
  2587. '             MAX.LEN           MAXIMUM LENGTH OF STRING TO INPUT
  2588. '             MESSAGE.LINE      WHERE IN A$() TO PUT THE EDITED LINE
  2589. '             RIGHT.MARGIN
  2590. '             SNOOP
  2591. '             STOP.INTERRUPTS
  2592. '             WAIT.EXPIRED
  2593. '
  2594. '  OUTPUTS -- A$(MESSAGE.LINE)  EDITED LINE
  2595. '
  2596. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  2597. '             string space.
  2598. '
  2599.      SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC
  2600.      LSET LINEMES$ = A$(MESSAGE.LINE)
  2601.      COL = LEN(A$(MESSAGE.LINE))
  2602.      STOP.INTERRUPTS = TRUE
  2603.      XXX = MAX.LEN - 3
  2604.      WAIT.EXPIRED = FALSE
  2605.      GOTO 3782
  2606. 3720 COL = COL + 1
  2607.      CALL SETABORT (AUTO.LOGOFF!, WAIT.BEFORE.DISCONNECT)
  2608. 3730 CALL FINDFUNC
  2609.      IF SUBROUTINE.PARAMETER < 0 THEN _
  2610.         EXIT SUB
  2611.      X$ = KEY.PRESSED$
  2612.      IF X$ = "" THEN _
  2613.         IF LOCAL.USER THEN _
  2614.            GOTO 3730 _
  2615.         ELSE GOTO 3732
  2616.      IF X$ = ESCAPE$ THEN _
  2617.         KEY.PRESSED$ = X$ : _
  2618.         EXIT SUB
  2619.      SEND.REMOTE = TRUE
  2620.      Z = INSTR(LINEEDIT.CHK$,X$)
  2621.      IF Z < 1 THEN _
  2622.         GOTO 3750 _
  2623.      ELSE IF Z > 4 THEN _
  2624.              GOTO 3870
  2625.      IF LOCAL.USER THEN _
  2626.         GOTO 3730
  2627. 3732 IF COMMPORT.STACK$ <> "" THEN _
  2628.         X$ = LEFT$(COMMPORT.STACK$,1) : _
  2629.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  2630.         GOTO 3738
  2631.      CALL EOFCOMM (CHAR%)
  2632.      IF CHAR% <> -1 THEN _
  2633.         GOTO 3736
  2634.      CALL FINDTIME (TI!)
  2635.      IF TI! > AUTO.LOGOFF! THEN _
  2636.         WAIT.EXPIRED = TRUE : _
  2637.         EXIT SUB
  2638. 3733 CALL CARRIER
  2639.      IF SUBROUTINE.PARAMETER THEN _
  2640.         EXIT SUB
  2641.      GOTO 3730
  2642. 3736 AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  2643. 3737 CALL GETCOM (X$)
  2644. 3738 SEND.REMOTE = REMOTE.ECHO
  2645. 3740 ON INSTR(LINEEDIT.CHK$,X$) GOTO 3730,3730,3730,3730,3870,3870,3870,3870,3870
  2646. 3750 IF SEND.REMOTE THEN _
  2647.         CALL PUTCOM(X$)
  2648.      CALL LPRNT (X$, 0)
  2649.      IF X$ = CARRIAGE.RETURN$ THEN _
  2650.         COL = COL - 1 : _
  2651.         GOTO 3850
  2652. 3770 IF COL > XXX THEN _
  2653.         IF X$ = " " THEN _
  2654.            CALL SKIPLINE (1) : _
  2655.            GOTO 3860
  2656. 3780 MID$(LINEMES$,COL) = X$
  2657. 3782 IF COL < MAX.LEN THEN _
  2658.         GOTO 3720
  2659.      Z = COL
  2660. 3800 IF Z < 1 THEN _
  2661.         Z = COL-1 : _
  2662.         GOTO 3820
  2663.      IF MID$(LINEMES$,Z,1) = " " THEN _
  2664.         GOTO 3820
  2665.      Z = Z - 1
  2666.      GOTO 3800
  2667. 3820 IF (NOT REMOTE.ECHO) AND (NOT LOCAL.USER) THEN _
  2668.         CALL SKIPLINE (1) : _
  2669.         GOTO 3860
  2670.      COL = MAX.LEN - Z
  2671.      IF SNOOP THEN _
  2672.         IF (POS(0) > COL) AND (COL > 0) THEN _
  2673.            LOCATE ,POS(0)-COL: _
  2674.            CALL LPRNT(STRING$(COL,32),0)
  2675. 3830 IF REMOTE.ECHO THEN _
  2676.         CALL PUTCOM (STRING$(COL,8) + STRING$(COL,32))
  2677. 3840 A$(MESSAGE.LINE) = LEFT$(LINEMES$,Z)
  2678.      A$(MESSAGE.LINE + 1) = MID$(LINEMES$,Z + 1,COL)
  2679.      CALL SKIPLINE (1)
  2680.      GOTO 3891
  2681. 3850 IF SEND.REMOTE AND LINE.FEEDS THEN _
  2682.         CALL PUTCOM(LINE.FEED$)
  2683. 3860 A$(MESSAGE.LINE) = LEFT$(LINEMES$,COL)
  2684.      GOTO 3891
  2685. 3870 IF COL = 1 THEN _
  2686.         GOTO 3730
  2687.      COL = COL-2
  2688. 3880 CALL LPRNT(LOCAL.BACKSPACE$,0)
  2689. 3885 IF SEND.REMOTE THEN _
  2690.         CALL PUTCOM (BACKSPACE$)
  2691. 3890 GOTO 3720
  2692. 3891 CALL CARRIER
  2693.      END SUB
  2694. 3952 ' $SUBTITLE: 'KILLMSG - subroutine to delete messages'
  2695. ' $PAGE
  2696. '
  2697. '  NAME    -- KILLMSG
  2698. '
  2699. '  INPUTS  --     PARAMETER                    MEANING
  2700. '              MESSAGE.TO.KILL              MESSAGE NUMBER TO KILL
  2701. '              ACTIVE.MESSAGES              NUMBER ACTIVE MESSAGES
  2702. '
  2703. '  OUTPUTS --  NONE
  2704. '
  2705. '  PURPOSE --  To kill/delete old or unnecessary messages
  2706. '
  2707.      SUB KILLMSG (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$) STATIC
  2708. '
  2709.      FIELD #1,128 AS MESSAGE.RECORD$
  2710.      QX = 1
  2711. 3955 IF QX > ACTIVE.MESSAGES THEN _
  2712.         A$ = "No such msg #" + _
  2713.              STR$(MESSAGE.TO.KILL) : _
  2714.         GOTO 4031
  2715.      IF M(QX,2) = MESSAGE.TO.KILL AND MESSAGE.TO.KILL => 1 THEN _
  2716.         GOTO 3970
  2717.      QX = QX + 1
  2718.      GOTO 3955
  2719. 3970 SUBROUTINE.PARAMETER = 3
  2720.      CALL FILELOCK
  2721.      GET 1,M(QX,1)
  2722.      IF USER.SECURITY.LEVEL >= SEC.KILL.ANY THEN _
  2723.         GOTO 4030
  2724. 3980 Z$ = MID$(MESSAGE.RECORD$,101,15)
  2725.      CALL TRIM (Z$)
  2726.      IF LEN(Z$) = 0 THEN _
  2727.         GOTO 4030
  2728. 3990 IF Z$ = "^READ^" OR Z$ = "^KILL^" THEN _
  2729.         IF (INSTR(MESSAGE.RECORD$,ACTIVE.USER.NAME$) > 0 _
  2730.            OR USER.SECURITY.LEVEL >= SEC.KILL.ANY) THEN _
  2731.            GOTO 4030 _
  2732.         ELSE MESSAGE.PASSWORD = TRUE : _
  2733.              ATTEMPTS.ALLOWED = 0 : _
  2734.              A$ = "Only sender & receiver can kill" : _
  2735.              GOTO 4031
  2736. 4000 IF LEFT$(Z$,1) = "!" THEN _
  2737.         Z$ = MID$(Z$,2)
  2738. 4010 PASSWORD.SAVE$ = Z$ + _
  2739.                       SPACE$(15 - LEN(Z$))
  2740.      ATTEMPTS.ALLOWED = 1
  2741.      MESSAGE.PASSWORD = TRUE
  2742.      CALL PASSWRD
  2743.      IF PASSWORD.FAILED THEN _
  2744.         GOTO 4031
  2745. 4030 MID$(MESSAGE.RECORD$,116,1) = DELETED.MESSAGE$
  2746.      PUT 1,LOC(1)
  2747.      SUBROUTINE.PARAMETER = 4
  2748.      CALL FILELOCK
  2749.      A$ = "Killed Msg # " + _
  2750.           STR$(MESSAGE.TO.KILL)
  2751.      CALL THREAD2 (MESSAGE.TO.KILL,ACTIVE.MESSAGES,GRN$)  'PE 01/12/89
  2752.      CALL UPDTCALR (A$,1)
  2753. 4031 SUBROUTINE.PARAMETER = 5
  2754.      CALL TPUT
  2755.      END SUB
  2756. 4554 ' $SUBTITLE: 'SETTHREAD - Sets up the interface for threading'
  2757. ' $PAGE
  2758. '
  2759. '  NAME    -- SETTHREAD
  2760. '
  2761. '  INPUTS  --     PARAMETER                    MEANING
  2762. '                 CURR.MSG.NUM          Current message number
  2763. '                 CURR.SUBJ$            Current message subject
  2764. '
  2765. '  OUTPUTS --  B$()                   Search msg by string
  2766. '              Q                      0 if thread cancelled
  2767. '
  2768. '  PURPOSE --  Find out how the caller wants to thread -
  2769. '              i.e. search messages by matching subject -
  2770. '              forward from current, back from current,
  2771. '              or forward from top of messages
  2772. '
  2773.      SUB SETTHREAD (CURR.MSG.NUM,CURR.SUBJ$) STATIC
  2774.      IF Q > 1 THEN _
  2775.         Z$ = B$(2) : _
  2776.         GOTO 4657
  2777. 4656 A$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)"
  2778.      TURBO.KEY = -TURBO.KEY.USER
  2779.      SUBROUTINE.PARAMETER = 1
  2780.      CALL TGET
  2781.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2782.         EXIT SUB
  2783.      Z$ = B$(1)
  2784. 4657 Z$ = LEFT$(Z$,1)
  2785.      X = INSTR("+-1",Z$)
  2786.      IF X = 0 THEN _
  2787.         GOTO 4656
  2788.      B$(1) = "R"
  2789.      IF X = 1 THEN _
  2790.         CURR.MSG.NUM = CURR.MSG.NUM + 1 _
  2791.      ELSE IF X = 2 THEN _
  2792.              CURR.MSG.NUM = CURR.MSG.NUM - 1 _
  2793.           ELSE CURR.MSG.NUM = 1 : _
  2794.                Z$ = "+"
  2795.      B$(3) = MID$(STR$(CURR.MSG.NUM),2) + Z$
  2796.      IF LEN(CURR.SUBJ$) < 4 OR LEFT$(CURR.SUBJ$,3) <> "(R)" THEN _
  2797.         B$(2) = CURR.SUBJ$ _
  2798.      ELSE B$(2) = MID$(CURR.SUBJ$,4)
  2799.      B$(2) = CHR$(34) + B$(2) + CHR$(34)
  2800.      LAST.INDEX = 3                                                  ' KG082504
  2801.      ANS.INDEX = 1                                                   ' KG082504
  2802.      Q = 3
  2803.      END SUB
  2804. 4773 ' $SUBTITLE: 'SYSOPCHAT - chat with sysop'
  2805. ' $PAGE
  2806. '
  2807. '  NAME    -- SYSOPCHAT
  2808. '
  2809. '  INPUTS  --     PARAMETER                    MEANING
  2810. '  OUTPUTS --  CM                     True if chat active
  2811. '
  2812. '  PURPOSE --  Lets sysop chat interactively with caller
  2813. '
  2814.      SUB SYSOPCHAT STATIC
  2815.      CM = TRUE
  2816.      CALL FINDTIME (TIME.CHAT.STARTED!)
  2817.      SUBROUTINE.PARAMETER = 1
  2818.      CALL LINE25
  2819.      A$(2) = ""
  2820. 4775 CALL LINEEDIT (1,72)
  2821.      IF KEY.PRESSED$ = ESCAPE$ OR _
  2822.         SUBROUTINE.PARAMETER < 0 THEN _
  2823.         GOTO 4777
  2824.      A$(1) = ""
  2825.      IF A$(2) <> "" THEN _
  2826.         A$ = A$(2) : _
  2827.         A$(1) = A$(2) : _
  2828.         A$(2) = "" _
  2829.      ELSE A$ = ""
  2830.      SUBROUTINE.PARAMETER = 4
  2831.      CALL TPUT
  2832.      IF SUBROUTINE.PARAMETER > -1 THEN _
  2833.         GOTO 4775
  2834. 4777 CM = 0
  2835.      CALL FINDTIME (TI!)
  2836.      ELAPSED! = FIX(TI! - TIME.CHAT.STARTED!)
  2837.      IF ELAPSED! < 0 THEN _
  2838.         ELAPSED! = TI! + (86400! - TIME.CHAT.STARTED!)
  2839.      SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + ELAPSED!
  2840.      IF NOT LOCAL.USER THEN _
  2841.         AUTO.LOGOFF! = TI! + WAIT.BEFORE.DISCONNECT
  2842.      CALL QTPUT("  Chat ended.  Returning to normal operation",2)
  2843.      END SUB
  2844. 5100 ' $SUBTITLE: 'REMNONALF - removes non-alpha chars from a string'
  2845. ' $PAGE
  2846. '
  2847. '  NAME    -- REMNONALF
  2848. '
  2849. '  INPUTS  --     PARAMETER                    MEANING
  2850. '                 STRNG$                   String to check
  2851. '                 MIN.CHAR            Remove chars with this
  2852. '                                     ASCII value or lower
  2853. '                 MAX.CHAR            Remove chars with this
  2854. '                                     ASCII value or higher
  2855. '
  2856. '  OUTPUTS --       STRNG$                   String returned
  2857. '  PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  2858. '
  2859.      SUB REMNONALF (STRNG$,MIN.CHAR,MAX.CHAR) STATIC
  2860.      LAST = LEN(STRNG$)
  2861.      J = 1
  2862.      WHILE J <= LAST
  2863.         K = ASC(MID$(STRNG$,J))
  2864.         IF K > MIN.CHAR AND K < MAX.CHAR THEN _
  2865.            J = J + 1 _
  2866.         ELSE STRNG$ = LEFT$(STRNG$,J - 1) + _
  2867.                       RIGHT$(STRNG$,LAST - J) : _
  2868.              LAST = LAST - 1
  2869.      WEND
  2870.      END SUB
  2871. 5200 ' $SUBTITLE: 'PAGELEN - Sets lines per page'
  2872. ' $PAGE
  2873. '
  2874. '  NAME    -- PAGELEN
  2875. '
  2876. '  INPUTS  --     PARAMETER                    MEANING
  2877. '               PAGE.LENGTH              Current page length
  2878. '
  2879. '  OUTPUTS --   PAGE.LENGTH              New page length
  2880. '
  2881. '  PURPOSE --  Change default lines per page
  2882. '
  2883.      SUB PAGELEN STATIC
  2884. 5202 A$ = "CHANGE page length from" + _
  2885.           STR$(PAGE.LENGTH) + _
  2886.           " TO (0-255, 0=continuous)"
  2887.      CALL POPCSTACK                                                  ' KG081201
  2888.      IF Q = 0 OR SUBROUTINE.PARAMETER = -1 THEN _
  2889.         CALL QTPUT1 ("No change") : _
  2890.         EXIT SUB
  2891. 5230 CALL CHECKINT (B$(ANS.INDEX))                                   ' KG081201
  2892.      IF EC <> 0 THEN _
  2893.         GOTO 5202
  2894.      IF TESTED.INTEGER.VALUE < 0 OR _
  2895.         TESTED.INTEGER.VALUE > 255 THEN _
  2896.         GOTO 5202
  2897.      PAGE.LENGTH = TESTED.INTEGER.VALUE
  2898.      CALL QTPUT1 ("Page Length Set to" + STR$(PAGE.LENGTH))          ' KG081201
  2899.      END SUB
  2900. 5507 ' $SUBTITLE: 'BAUD450 -- Changes 300 baud to 450'
  2901. ' $PAGE
  2902. '  NAME    -- BAUD450
  2903. '
  2904. '  INPUTS  -- PARAMETER             MEANING
  2905. '             BPS
  2906. '
  2907. '  OUTPUTS -- BPS
  2908. '
  2909. '  PURPOSE -- Allow 300 baud modems to bump up to 450 baud
  2910. '
  2911.      SUB BAUD450 STATIC
  2912.      IF BPS <> -1 THEN _
  2913.         CALL QTPUT1 ("Sorry, only 300 baud can change speed") : _
  2914.         EXIT SUB
  2915.      IF FOSSIL THEN _
  2916.         CALL QTPUT1 ("Sorry, 450 baud NOT supported under FOSSIL") : _
  2917.         EXIT SUB
  2918.      A$ = "Change to 450 baud (Y,[N])"
  2919.      TURBO.KEY = -TURBO.KEY.USER
  2920.      SUBROUTINE.PARAMETER = 1
  2921.      CALL TGET
  2922.      IF SUBROUTINE.PARAMETER = -1 OR NOT YES THEN _
  2923.         EXIT SUB
  2924. 5510 CALL QTPUT1 ("Change your baud rate to 450")
  2925.      CALL DELAYIT (9)
  2926.      C = 0
  2927.      BPS = -2
  2928.      CALL SETBAUD
  2929.      A$ = " and then press [ENTER] until I respond"
  2930.      SUBROUTINE.PARAMETER = 9
  2931.      CALL TGET
  2932. 5530 C = C + 1
  2933.      CALL CARRIER
  2934.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2935.         EXIT SUB
  2936.      IF C = 20 THEN _
  2937.         CALL UPDTCALR ("Baud change failed",1) : _
  2938.         BPS = -1 : _
  2939.         CALL SETBAUD : _
  2940.         EXIT SUB
  2941.      CALL DELAYIT (1)
  2942. 5535 CALL EOFCOMM (CHAR%)
  2943.      IF CHAR% = -1 THEN _
  2944.         GOTO 5530
  2945. 5536 CALL PUTCOM(A$)
  2946.      IF A$ = "" THEN _
  2947.         A$ = " "
  2948.      IF ASC(A$) = 13 THEN _
  2949.         GOTO 5540
  2950.      IF SUBROUTINE.PARAMETER = -1 THEN _
  2951.         EXIT SUB
  2952. 5537 GOTO 5530
  2953. 5540 A$ = "Changed to 450 baud"
  2954.      CALL QTPUT1 (A$)
  2955.      CALL UPDTCALR (A$,1)
  2956.      BPS = -2
  2957.      A$ = ""
  2958.      END SUB
  2959. 9140 ' $SUBTITLE: 'GETIME - subroutine to calculate elapsed time'
  2960. ' $PAGE
  2961. '
  2962. '  NAME    -- GETIME
  2963. '
  2964. '  INPUTS  --     PARAMETER                    MEANING
  2965. '                TIME.LOGGED.ON$
  2966. '
  2967. '  OUTPUTS --  HH                     NUMBER OF HOURS ON
  2968. '              MM                     NUMBER OF MINUTES ON
  2969. '              SS                     NUMBER OF SECONDS ON
  2970. '
  2971. '  PURPOSE --  Calculate the elapsed time a user has been on
  2972. '
  2973.      SUB GETIME STATIC
  2974.      H = VAL(MID$(TIME.LOGGED.ON$,1,2))
  2975.      M = VAL(MID$(TIME.LOGGED.ON$,4,2))
  2976.      S = VAL(MID$(TIME.LOGGED.ON$,7,2))
  2977.      X$ = TIME$
  2978.      HH = VAL(MID$(X$,1,2))
  2979.      MM = VAL(MID$(X$,4,2))
  2980.      JJ = VAL(MID$(X$,7,2))
  2981.      IF S <= JJ THEN _
  2982.         SSS = JJ - S _
  2983.      ELSE SSS = 60 - (S - JJ) : _
  2984.           M = M + 1
  2985. 9150 IF M <= MM THEN _
  2986.         MMM = MM - M _
  2987.      ELSE MMM = 60 - (M - MM) : _
  2988.           H = H + 1
  2989. 9160 IF H <= HH THEN _
  2990.         HHH = HH - H _
  2991.      ELSE HHH = 24 - (H - HH)
  2992.      END SUB
  2993. 9600 ' $SUBTITLE: 'DEFAULTU - subroutine to update user defauts'
  2994. ' $PAGE
  2995. '
  2996. '  NAME    -- DEFAULTU
  2997. '
  2998. '  INPUTS  --     PARAMETER                    MEANING
  2999. '             AUTODOWNLOAD.DESIRED
  3000. '             BOLD.TEXT$              Ansi bold (0 no, 1 yes)
  3001. '             CHECK.BULLETIN.LOGON
  3002. '             EXPERT.USER
  3003. '             GR
  3004. '             LAST.MESSAGE.READ
  3005. '             LINE.FEEDS
  3006. '             NULLS
  3007. '             PAGE.LENGTH
  3008. '             PROMPT.BELL
  3009. '             REG.DATE$
  3010. '             REQ.QUES.ANSWERED
  3011. '             RIGHT.MARGIN
  3012. '             SKIP.FILES.LOGON
  3013. '             TIMES.LOGGED.ON
  3014. '             UPPER.CASE
  3015. '             USER.OPTIONS$
  3016. '             USER.TEXT.COLOR          Ansi of color (31-37)
  3017. '             USER.TRANSFER.DEFAULT$
  3018. '
  3019. '  OUTPUTS--  USER.OPTONS$
  3020. '
  3021. '  PURPOSE --  To update the user's record with their options.
  3022. '  Meaning of graphics preference stored is as follows: where # is
  3023. '  value stored for the color.  E.g. if graphics perference for text
  3024. '  files is color, and preference for normal text is light yellow,
  3025. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  3026. '  Blue, Purple, Cyan, and White.
  3027. '
  3028. '             normal                  bold
  3029. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  3030. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  3031. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  3032. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  3033. '
  3034.      SUB DEFAULTU STATIC
  3035.      A =        -PROMPT.BELL           -2 * EXPERT.USER _
  3036.             -4 * NULLS                 -8 * UPPER.CASE _
  3037.            -16 * LINE.FEEDS           -32 * CHECK.BULLETIN.LOGON _
  3038.            -64 * SKIP.FILES.LOGON    -128 * AUTODOWNLOAD.DESIRED _
  3039.           -256 * REQ.QUES.ANSWERED   -512 * MAIL.WAITING _
  3040.          -1024 * (NOT HIGHLIGHT.OFF)-2048 * TURBO.KEY.USER
  3041.      X = 3*USER.TEXT.COLOR - 63 + 21*VAL(BOLD.TEXT$) + GR
  3042.      IF X < 1 OR X > 255 THEN _
  3043.         X = 48
  3044.      LSET USER.OPTIONS$ = _
  3045.         MKI$(TIMES.LOGGED.ON) + _
  3046.         MKI$(LAST.MESSAGE.READ) + _
  3047.         USER.TRANSFER.DEFAULT$ + _
  3048.         CHR$(X) + _
  3049.         MKI$(RIGHT.MARGIN) + _
  3050.         MKI$(A) + _
  3051.         REG.DATE$ + _
  3052.         CHR$(PAGE.LENGTH) + _
  3053.         ECHOER$
  3054.      END SUB
  3055. 9801 ' $SUBTITLE: 'WHOSON - subroutine to display who is on'
  3056. ' $PAGE
  3057. '
  3058. '  NAME    -- WHOSON
  3059. '
  3060. '  INPUTS  --     PARAMETER                    MEANING
  3061. '                NUM.NODES                   # of nodes to check
  3062. '                ACTIVE.MESSAGE.FILE$        Current message file
  3063. '                ORIG.MESSAGE.FILE$          Main msg file
  3064. '
  3065. '  OUTPUTS --  None
  3066. '
  3067. '  PURPOSE --  To display who is on each node.
  3068. '
  3069.      SUB WHOSON (NUM.NODES) STATIC
  3070.      A1$ = ACTIVE.MESSAGE.FILE$
  3071.      ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  3072.      CALL OPENMSG
  3073.      FIELD 1, 128 AS MESSAGE.RECORD$
  3074.      FOR NODE.INDEX = 2 TO NUM.NODES + 1
  3075.         GET 1,NODE.INDEX
  3076.         A$ = FG.1$ + "Node" + _
  3077.              STR$(NODE.INDEX - 1) + FG.2$
  3078.         REC.INDEX = VAL(MID$(MESSAGE.RECORD$,44,2))
  3079.         IF REC.INDEX = 0 THEN _
  3080.            REC.INDEX = -1
  3081.         AX$ = MID$("      300  450 1200 2400 4800 960019200",(-5 * REC.INDEX ),5) + _
  3082.               " BAUD: "
  3083.         IF MID$(MESSAGE.RECORD$,55,2) = "-1" AND NOT SYSOP THEN _
  3084.            Y$ = "SYSOP" + SPACE$(21) _
  3085.         ELSE Y$ = MID$(MESSAGE.RECORD$,1,26)
  3086.         AX$ = AX$ + FG.3$ + Y$
  3087.         IF MID$(MESSAGE.RECORD$,40,2) <> "-1" THEN _
  3088.            AX$ = AX$ + FG.4$ + MID$(MESSAGE.RECORD$,93,22)
  3089.         IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
  3090.            A$ = A$ + "  Online at " + _
  3091.                 AX$ _
  3092.         ELSE IF NOT SYSOP THEN _
  3093.                 A$ = A$ + _
  3094.                      " Waiting for next caller" _
  3095.              ELSE A$ = A$ + _
  3096.                        " Offline at " + _
  3097.                        AX$
  3098.         CALL QTPUT1 (A$)
  3099.         CALL ASKMORE ("",TRUE,TRUE,ANS.INDEX,FALSE)                  ' KG081201
  3100.         IF NO THEN _                                                 ' BK080901
  3101.            NODE.INDEX = NUM.NODES + 2                                ' BK080901
  3102.      NEXT                                                            ' BK080901
  3103.      ACTIVE.MESSAGE.FILE$ = A1$
  3104.      CALL QTPUT (EMPHASIZE.OFF$,0)                                   ' MZ060303
  3105.      END SUB
  3106. 10410 ' $SUBTITLE: 'RECOVMSG - sub to recover deleted messages'
  3107. ' $PAGE
  3108. '
  3109. '  NAME    -- RECOVMSG
  3110. '
  3111. '  INPUTS  --     PARAMETER                    MEANING
  3112. '               MESSAGE.TO.RECOVER          MESSAGE NUMBER TO RECOVER
  3113. '               FIRST.MESSAGE.RECORD        RECORD # FOR FIRST MSG
  3114. '
  3115. '  OUTPUTS --  ACTION.FLAG                 SET TO 0 IF ERROR
  3116. '                                          SET TO -1 IF NO ERROR
  3117. '
  3118. '  PURPOSE --  To recover deleted messages.  Note that this is only
  3119. '              possible if you have not compressed your message file
  3120. '              using config.
  3121. '
  3122.       SUB RECOVMSG (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG,GRN$) STATIC
  3123.       FIELD #1,128 AS MESSAGE.RECORD$
  3124.       MESSAGE.RECORD = FIRST.MESSAGE.RECORD
  3125.       SUBROUTINE.PARAMETER = 5
  3126.       CALL TPUT
  3127. 10420 GET 1,MESSAGE.RECORD
  3128.       NUMBER.RECORDS.IN.MESSAGE = VAL(MID$(MESSAGE.RECORD$,117,4))
  3129.       IF NUMBER.RECORDS.IN.MESSAGE < 1 THEN _
  3130.          A$ = "USE CONFIG TO REPAIR YOUR MESSAGE FILE" : _
  3131.          GOTO 10485
  3132.       IF MESSAGE.RECORD => NEXT.MESSAGE.RECORD THEN _
  3133.          A$ = "No Msg #" + _
  3134.               STR$(MESSAGE.TO.RECOVER) : _
  3135.          GOTO 10485
  3136. 10440 IF VAL(MID$(MESSAGE.RECORD$,2,4)) <> MESSAGE.TO.RECOVER THEN _
  3137.          MESSAGE.RECORD = MESSAGE.RECORD + NUMBER.RECORDS.IN.MESSAGE : _
  3138.          GOTO 10420
  3139. 10450 IF INSTR(MESSAGE.RECORD$,DELETED.MESSAGE$) <> 0 THEN _
  3140.          SUBROUTINE.PARAMETER = 3 : _
  3141.          CALL TPUT : _
  3142.          LSET MESSAGE.RECORD$ = LEFT$(MESSAGE.RECORD$,115) + _
  3143.                                 ACTIVE.MESSAGE$ + _
  3144.                                 MID$(MESSAGE.RECORD$,117) : _
  3145.          PUT 1,LOC(1) : _
  3146.          SUBROUTINE.PARAMETER = 4 : _
  3147.          CALL TPUT : _
  3148.          A$ = "Restored Msg #" + _
  3149.               STR$(MESSAGE.TO.RECOVER) : _
  3150.          ACTION.FLAG = TRUE : _
  3151.      CALL THREAD4 (MESSAGE.TO.RECOVER,FIRST.MESSAGE.RECORD,ACTION.FLAG,GRN$) : _ 
  3152.          GOTO 10485
  3153. 10480 A$ = "Msg #" + _
  3154.            STR$(MESSAGE.TO.RECOVER) + _
  3155.            " not Dead"
  3156. 10485 CALL QTPUT1 (A$)
  3157.       END SUB
  3158. 10600 ' $SUBTITLE: 'UPDATEU -- Update the users record at logoff'
  3159. ' $PAGE
  3160. '  NAME    -- UPDATEU
  3161. '
  3162. '  INPUTS  -- PARAMETER             MEANING
  3163. '             ADJUSTED.SECURITY
  3164. '             CURRENT.DATE$
  3165. '             DOWNLOADS
  3166. '             ELAPSED.TIME
  3167. '             LIST.DIRECTORY
  3168. '             MAIN.USER.FILE.INDEX
  3169. '             SECONDS.PER.SESSION!
  3170. '             UPLOADS
  3171. '             USER.SECURITY.LEVEL
  3172. '
  3173. '  OUTPUTS -- ELAPSED.TIME$
  3174. '             LIST.NEW.DATE$
  3175. '             SECURITY.LEVEL$
  3176. '             USER.DOWNLOADS$
  3177. '             USER.UPLOADS$
  3178. '
  3179. '  PURPOSE -- Update the user record for the user when the user
  3180. '             exits RBBS-PC.
  3181. '
  3182.       SUB UPDATEU (LOGGING.OFF) STATIC
  3183.       IF ACTIVE.USER.NAME$ = "" OR FIRST.NAME$ = "" THEN _
  3184.          EXIT SUB
  3185.       IF ACTIVE.USER.FILE$ = ORIG.USER.FILE$ THEN _
  3186.          UPLOADS = GLOBAL.UPLOADS : _
  3187.          DOWNLOADS = GLOBAL.DOWNLOADS : _
  3188.          DL.TODAY! = GLOBAL.DL.TODAY! : _
  3189.          BYTES.TODAY! = GLOBAL.BYTES.TODAY! : _
  3190.          DLBYTES! = GLOBAL.DLBYTES! : _
  3191.          ULBYTES! = GLOBAL.ULBYTES!
  3192.       CALL TIMEREMAIN (TIME.REMAINING!)
  3193.       Q! = ELAPSED.TIME + _                                          ' KP061804
  3194.            ((SECONDS.PER.SESSION! - TIME.CREDITS!)/ 60) - _
  3195.            TIME.REMAINING!
  3196.       IF Q! < -32000 THEN _
  3197.          Q! = -32000 _
  3198.       ELSE IF Q! > 32000 THEN _
  3199.          Q! = 32000
  3200.       IF USER.FILE.INDEX < 1 THEN _
  3201.          GOTO 10607
  3202.       UPDATE.DEFAULTS = TRUE
  3203. 10602 SUBROUTINE.PARAMETER = 6
  3204.       CALL FILELOCK
  3205.       CALL OPENUSER (HIGHEST.USER.RECORD)
  3206.       FIELD 5,31 AS USER.NAME$, _
  3207.               15 AS PASSWORD$, _
  3208.                2 AS SECURITY.LEVEL$, _
  3209.               14 AS USER.OPTIONS$,  _
  3210.               24 AS CITY.STATE$, _
  3211.               3 AS MACHINE.TYPE$, _
  3212.               4 AS TODAY.DL$, _
  3213.               4 AS TODAY.BYTES$, _
  3214.               4 AS DL.BYTES$, _
  3215.               4 AS UL.BYTES$, _
  3216.               14 AS LAST.DATE.TIME.ON$, _
  3217.                3 AS LIST.NEW.DATE$, _
  3218.                2 AS USER.DOWNLOADS$, _
  3219.                2 AS USER.UPLOADS$, _
  3220.                2 AS ELAPSED.TIME$
  3221. 10604 GET 5,USER.FILE.INDEX
  3222.       IF UPDATE.DEFAULTS THEN _
  3223.          CALL DEFAULTU
  3224.       IF LIST.DIRECTORY THEN _
  3225.          LSET LIST.NEW.DATE$ = CHR$(VAL(MID$(CURRENT.DATE$,7,2))) + _
  3226.                                CHR$(VAL(MID$(CURRENT.DATE$,1,2))) + _
  3227.                                CHR$(VAL(MID$(CURRENT.DATE$,4,2)))
  3228. 10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS)
  3229.       LSET USER.UPLOADS$ = MKI$(UPLOADS)
  3230.          LSET TODAY.DL$ = MKS$(DL.TODAY!)
  3231.          LSET TODAY.BYTES$ = MKS$(BYTES.TODAY!)
  3232.          LSET DL.BYTES$ = MKS$(DLBYTES!)
  3233.          LSET UL.BYTES$ = MKS$(ULBYTES!)
  3234.       LSET ELAPSED.TIME$ = MKI$(Q!)
  3235.       IF ADJUSTED.SECURITY THEN _
  3236.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  3237.       PUT 5,USER.FILE.INDEX
  3238.       SUBROUTINE.PARAMETER = 8
  3239.       CALL FILELOCK
  3240.       IF ACTIVE.USER.FILE$ <> ORIG.USER.FILE$ AND LOGGING.OFF THEN _
  3241.          ACTIVE.USER.FILE$ = ORIG.USER.FILE$ : _
  3242.          USER.FILE.INDEX = ORIG.USER.FILE.INDEX : _
  3243.          UPDATE.DEFAULTS = FALSE : _
  3244.          GOTO 10602
  3245. 10607 IF EXIT.TO.DOORS OR NOT LOGGING.OFF THEN _
  3246.          EXIT SUB
  3247.       IF MAX.PER.DAY <= 0 THEN _
  3248.          X = MINUTES.PER.SESSION! _
  3249.       ELSE X = (MAX.PER.DAY - Q!) : _
  3250.            X = -(X > 0) * X:
  3251.       CALL QTPUT (CX$(3)+STR$(X)+CX$(6)+" min"+CX$(5)+" left for next call today",1)
  3252.       CALL QTPUT(CX$(6)+FIRST.NAME$ +CX$(2)+ ", Thanks for calling "+_
  3253. CX$(5)+RBBS.NAME$+CX$(3)+" and please call again!",1)
  3254.       IF NOT HIGHLIGHT.OFF THEN _
  3255.          CALL QTPUT1 (COLOR.RESET$)
  3256.       CALL DELAYIT (8 + BPS)
  3257.       END SUB
  3258. 10935 ' $SUBTITLE: 'DOSEXIT -- Setup to exit to DOS for SYSOP'
  3259. ' $PAGE
  3260. '  NAME    -- DOSEXIT
  3261. '
  3262. '  INPUTS  -- PARAMETER             MEANING
  3263. '             COM.PORT$
  3264. '             DOORS.TERMINAL.TYPE
  3265. '             MULTI.LINK.PRESENT
  3266. '             RBBS.BAT$
  3267. '             REDIRECT.IO.METHOD
  3268. '             USE.DEVICE.DRIVER$
  3269. '
  3270. '  OUTPUTS -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3271. '                                  RCTTY.BAT$
  3272. '             B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3273. '
  3274. '  PURPOSE -- Set up B$() and Q in order to call "RBBSEXIT" and
  3275. '             exit to DOS for the remote RBBS-PC sysop
  3276. '
  3277.       SUB DOSEXIT STATIC
  3278.       IF MULTI.LINK.PRESENT AND _
  3279.          DOORS.TERMINAL.TYPE > 0 THEN _
  3280.          FF = 0 : _
  3281.          GOTO 10950
  3282.       A$(1) = "ECHO OFF"
  3283.       IF USE.DEVICE.DRIVER$ <> "" THEN _
  3284.          PORT$ = USE.DEVICE.DRIVER$ _
  3285.       ELSE PORT$ = "GATE" + RIGHT$(COM.PORT$,1)    'pe Gateway Mod
  3286.       IF REDIRECT.IO.METHOD THEN _
  3287.          FF = 5 : _
  3288.          A$(2) = "CTTY " + _
  3289.                  PORT$ : _
  3290.          A$(3) = DISK.FOR.DOS$ + _
  3291.                  "COMMAND" : _
  3292.          A$(4) = "CTTY CON" : _
  3293.          A$(5) = RBBS.BAT$ _
  3294.       ELSE FF = 3 : _
  3295.            A$(2) = DISK.FOR.DOS$ + _
  3296.                    "COMMAND >" + _
  3297.                    PORT$ + _
  3298.                    " <" + _
  3299.                    PORT$ : _
  3300.            A$(3) = RBBS.BAT$
  3301. 10950 CALL AMORPMTD                                                  ' KG061203
  3302.       CALL UPDTCALR ("Exited to DOS at " + TIM$,2)
  3303.       CALL QTPUT1 ("RBBS-PC " + VERSION.ID$)
  3304.       CALL QTPUT1 ("SYSOP in Remote Console Mode")
  3305.       CALL RBBSEXIT (A$(),FF)
  3306.       END SUB
  3307. 10976 ' $SUBTITLE: 'WORDINFILE -- Searches a file to find a word'
  3308. ' $PAGE
  3309. '  NAME    -- WORDINFILE
  3310. '
  3311. '  INPUTS  -- PARAMETER             MEANING
  3312. '             FILNAME$      FILE TO SEARCH IN
  3313. '             STRNG$        STRING TO SEARCH FOR
  3314. '
  3315. '  OUTPUTS -- INFILE        WHETHER STRING FOUND IN FILE
  3316. '
  3317. '  PURPOSE -- Searches for "STRNG$" in file "FILNAME$."  Used to
  3318. '             limit doors and questionnaires to those specified
  3319. '             in their menu files.  The "STRNG$" is capitalized
  3320. '             but not the lines in the file, so must be exact
  3321. '             case-sensitive match to be found.  The only character
  3322. '             that can immediately proceed or end a name to be
  3323. '             found must be a blank.
  3324. '
  3325.       SUB WORDINFILE (FILNAME$,STRNG$,INFILE) STATIC
  3326.       INFILE = FALSE
  3327.       CALL FINDIT (FILNAME$)
  3328.       IF NOT OK THEN _
  3329.          EXIT SUB
  3330.       X = 0
  3331.       CALL ALLCAPS (STRNG$)
  3332.       WHILE NOT EOF(2) AND X < 1
  3333.          LINE INPUT #2,A$
  3334.          Y = 1
  3335. 10978    X = INSTR(Y,A$,STRNG$)
  3336.          IF X < 1 THEN _
  3337.             GOTO 10980
  3338.          Y = X + 1
  3339.          IF X > 1 THEN _
  3340.             IF MID$(A$,X - 1,1) <> " " THEN _
  3341.                X = 0
  3342.          IF X > 0 THEN _
  3343.             L = LEN(STRNG$) : _
  3344.             IF LEN(A$) => (X + L) THEN _
  3345.                IF MID$(A$,X + L,1) <> " " THEN _
  3346.                   X = 0
  3347.          IF X = 0 THEN _
  3348.             GOTO 10978
  3349. 10980 WEND
  3350.       CLOSE 2
  3351.       INFILE = (X > 0)
  3352.       END SUB
  3353. 10983 ' $SUBTITLE: 'DOOREXIT -- Setup to exit to a "door"'
  3354. ' $PAGE
  3355. '  NAME    -- DOOREXIT
  3356. '
  3357. '  INPUTS  -- PARAMETER             MEANING
  3358. '             MULTI.LINK.PRESENT
  3359. '             NODE.ID$
  3360. '             RBBS.BAT$
  3361. '             Z$
  3362. '
  3363. '  OUTPUTS -- Q                    NUMBER OF LINES TO WRITE OUT TO
  3364. '                                  RCTTY.BAT$
  3365. '             B$()                 LINES TO WRITE OUT TO RCTTY.BAT$
  3366. '
  3367. '  PURPOSE -- Set up B$() and Q in order to call "EXITRBBS" and
  3368. '             exit RBBS-PC to invoke another program
  3369. '
  3370.       SUB DOOREXIT STATIC
  3371.       IF Z$ = "" OR _
  3372.          Z$ = "NONE" THEN _
  3373.          EXIT SUB
  3374.       CALL FINDIT (Z$)
  3375.       IF NOT OK THEN _
  3376.          GOTO 10986
  3377.       EXIT.TO$ = LEFT$(Z$,LEN(Z$) - 4)
  3378.       EXIT.METHOD$ = ""
  3379.       DOORED.TO$ = EXIT.TO$
  3380.       CALL FINDIT (DOORS.DEF$)
  3381.       IF NOT OK THEN _
  3382.          EXIT.TO$ = EXIT.TO$ + " " + NODE.ID$ : _
  3383.          GOTO 10989
  3384. 10985 CALL READPARMS (A$(),8,1)
  3385.       IF EC > 0 THEN _
  3386.          EXIT.TO$ = EXIT.TO$ + " " + NODE.ID$ : _
  3387.          GOTO 10989
  3388.       IF EXIT.TO$ <> A$(1) THEN _
  3389.          GOTO 10985
  3390.       CALL CHECKINT (A$(2))
  3391.       IF EC > 0 THEN _
  3392.          EC = 0 : _
  3393.          GOTO 10985
  3394.       IF USER.SECURITY.LEVEL < TESTED.INTEGER.VALUE THEN _
  3395.          CALL QTPUT1 ("Insufficient security for door") : _
  3396.          EXIT SUB
  3397.       X$ = LEFT$(A$(5),INSTR(A$(5)+" "," ")-1)
  3398.       CALL FINDIT (X$)
  3399.       IF NOT OK THEN _
  3400.          GOTO 10986
  3401.       FILE.NAME$ = A$(3)
  3402.       EXIT.METHOD$ = A$(4)
  3403.       EXIT.TEMPLATE$ = A$(5)
  3404.       DOOR.DISPLAY$ = A$(7)
  3405.       DOOR.TIME$ = A$(8)
  3406.       CALL ASKUSERS
  3407.       CALL SMARTTXT (EXIT.TEMPLATE$,FALSE,FALSE)                     ' CS062802
  3408.       CALL METAGSR (EXIT.TEMPLATE$,FALSE)
  3409.       EXIT.TO$ = EXIT.TEMPLATE$
  3410.       GOTO 10989
  3411. 10986 A$ = "Missing door program"
  3412.       CALL UPDTCALR (A$ + " " + Z$,1)
  3413.       SNOOP = TRUE
  3414.       CALL LPRNT (A$,1)
  3415.       EXIT SUB
  3416. 10989 IF TRANSFER.FUNCTION = 3 THEN _
  3417.          Y$ = "Registration" _
  3418.       ELSE Y$ = DOORED.TO$
  3419.       A$ = Y$ + _
  3420.            " door opened at " + _
  3421.            TIME$ + _
  3422.            " on " + _
  3423.            DATE$
  3424.       SUBROUTINE.PARAMETER = 5
  3425.       CALL TPUT
  3426.       CALL UPDTCALR (DOORED.TO$ + " door opened!",2)
  3427.       CALL QTPUT (Cx$(5)+"Takes approx 30 - 40 seconds.....",2)
  3428.       CLOSE 2
  3429.       OPEN "O",2,"DORINFO" + _
  3430.                  NODE.FILE.ID$ + _
  3431.                  ".DEF"
  3432.       PRINT #2,RBBS.NAME$
  3433.       PRINT #2,SYSOP.FIRST.NAME$
  3434.       PRINT #2,SYSOP.LAST.NAME$
  3435.       IF LOCAL.USER THEN _
  3436.          PRINT #2,"COM0" _
  3437.       ELSE PRINT #2,COM.PORT$
  3438.       B$ = MID$(BAUD.PARITY$,INSTR(BAUD.PARITY$," B"))
  3439.       PRINT #2,TALK.TO.MODEM.AT$;B$
  3440.       PRINT #2,NETWORK.TYPE
  3441.       IF GLOBAL.SYSOP THEN _
  3442.          PRINT #2,"SYSOP" : _
  3443.          PRINT #2,"" _
  3444.       ELSE PRINT #2,FIRST.NAME$ : _
  3445.            PRINT #2,LAST.NAME$
  3446.       PRINT #2,CITY.STATE$
  3447.       PRINT #2,GR
  3448.       PRINT #2,USER.SECURITY.LEVEL
  3449.       CALL TIMEREMAIN (TIME.REMAINING!)
  3450.       CALL CHECKINT (DOOR.TIME$)
  3451.       IF EC = 0 AND TESTED.INTEGER.VALUE > 0 THEN _                  ' KG080201
  3452.          IF TIME.REMAINING! > TESTED.INTEGER.VALUE THEN _            ' KG080301
  3453.             TIME.REMAINING! = TESTED.INTEGER.VALUE                   ' KG080301
  3454.       PRINT #2,INT(TIME.REMAINING!)
  3455.       PRINT #2,FOSSIL
  3456.       IF EXIT.METHOD$ = "S" THEN _
  3457.          CALL SHELLEXIT (EXIT.TEMPLATE$) : _
  3458.          EXIT.TO.DOORS = TRUE : _
  3459.          CALL BUFFILE (DOOR.DISPLAY$,X) : _
  3460.          CALL DOORRTN _
  3461.       ELSE A$(1) = DISK.FOR.DOS$ + _
  3462.                   "COMMAND /C " + _
  3463.                   EXIT.TO$ : _
  3464.            A$(2) = RBBS.BAT$ : _
  3465.            CALL RBBSEXIT (A$(),2)
  3466.       END SUB
  3467. 10992 ' $SUBTITLE: 'RBBSEXIT -- Setup to exit RBBS'
  3468. ' $PAGE
  3469. '  NAME    -- RBBSEXIT
  3470. '
  3471. '  INPUTS  -- PARAMETER             MEANING
  3472. '             LINE.ARA        Array of lines to write to batch file
  3473. '             NUM.LINES       How many lines in array
  3474. '
  3475. '  OUTPUTS -- RCTTY.BAT$
  3476. '
  3477. '  PURPOSE -- To create a batch file that control can be passed to
  3478. '             and to exit RBBS-PC while still keeping carrier up
  3479. '
  3480.       SUB RBBSEXIT (LINE.ARA$(1),NUM.LINES) STATIC
  3481.       CLOSE 2
  3482.       IF NUM.LINES = 0 THEN _
  3483.          GOTO 10994
  3484.       OPEN "O",2,RCTTY.BAT$
  3485.       FOR I = 1 TO NUM.LINES
  3486.          IF LINE.ARA$(I) <> "" THEN _
  3487.             PRINT #2,LINE.ARA$(I)
  3488.       NEXT
  3489.       CLOSE 2
  3490. 10994 CLOSE 3
  3491.       EXIT.TO.DOORS = TRUE
  3492.       IF NOT FOSSIL THEN _
  3493.          OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  3494.       IF NOT PRIVATE.DOOR THEN _
  3495.          CALL MLINIT (2)
  3496. 10996 CALL UPDATEU (TRUE)
  3497.       CALL GETIME
  3498.       CALL SAVEPROF (1)
  3499.       IF NUM.LINES = 0 THEN _
  3500.          EXIT SUB
  3501.       CALL DELAYIT (9 + BPS)
  3502.       IF FOSSIL THEN _
  3503.          CALL FOSEXIT(COMPORT%)
  3504.       SYSTEM
  3505.       END SUB
  3506. 12000 ' $SUBTITLE: 'SETSECT -- Setup section prompts'
  3507. ' $PAGE
  3508. '  NAME    -- SETSECT         Doug Azzarito
  3509. '
  3510. '  INPUTS  -- PARAMETER             MEANING
  3511. '             MENU.INDEX      2 = user is in MAIN section
  3512. '                             3 = user is in FILE section
  3513. '                             4 = user is in UTIL section
  3514. '                             6 = user is in LIBR section
  3515. '
  3516. '  OUTPUTS -- SECTION$        4 character section name
  3517. '             ACTIVE.MENU$    1 character section name
  3518. '             SECTION.PROMPT$ Section name (if SHOW.SECTION config)
  3519. '             COMMAND.PROMPT$ Command input prompt string
  3520. '             SECTION.OPTS$   List of options valid in this sect
  3521. '             INVALID.OPTS$   List of options invalid in this sect
  3522. '             SUB.SECTION     Index into security array for section
  3523. '
  3524. '  PURPOSE -- To build the prompt strings for the current section
  3525. '
  3526.       SUB SETSECT STATIC
  3527.       ON MENU.INDEX GOTO 12001, 12010,12005,12020,12001,12015
  3528. 12001 EXIT SUB
  3529. 12005 LSET SECTION$ = "FILE"
  3530.       SECTION.OPTS$ = FILE.OPTS$
  3531.       INVALID.OPTS$ = INVALID.FILE.OPTS$
  3532.       SUB.SECTION = BEG.FILE
  3533.       GOTO 12025
  3534. 12010 LSET SECTION$ = "MAIN"
  3535.       SECTION.OPTS$ = MAIN.OPTS$
  3536.       INVALID.OPTS$ = INVALID.MAIN.OPTS$
  3537.       SUB.SECTION = BEG.MAIN
  3538.       GOTO 12025
  3539. 12015 LSET SECTION$ = "LIBR"
  3540.       SECTION.OPTS$ = LIBRARY.OPTS$
  3541.       INVALID.OPTS$ = INVALID.LIBRARY.OPTS$
  3542.       SUB.SECTION = BEG.LIBRARY
  3543.       GOTO 12025
  3544. 12020 LSET SECTION$ = "UTIL"
  3545.       SECTION.OPTS$ = UTIL.OPTS$
  3546.       INVALID.OPTS$ = INVALID.UTIL.OPTS$
  3547.       SUB.SECTION = BEG.UTIL
  3548. 12025 ACTIVE.MENU$ = LEFT$(SECTION$,1)
  3549.       LSET LAST.COMMAND$ = ACTIVE.MENU$ + " "                        ' KG060701
  3550.       IF SHOW.SECTION THEN _
  3551.          SECTION.PROMPT$ = SECTION$ _
  3552.       ELSE SECTION.PROMPT$ = "Your"
  3553.       IF COMMANDS.IN.PROMPT=0 THEN _
  3554.           SECTION.OPTS$ = ""
  3555.       COMMAND.PROMPT$ = SECTION.PROMPT$ + _
  3556.                         " command" + _
  3557.                         SECTION.OPTS$
  3558.       END SUB
  3559. 12878 ' $SUBTITLE: 'UNTILRIGHT - asks question until answer okay'
  3560. ' $PAGE
  3561. '
  3562. '  NAME    -- UNTILRIGHT
  3563. '
  3564. '  INPUTS  -- PARAMETER             MEANING
  3565. '             QUES$         QUESTION TO BE ASKED THE USER
  3566. '             ANS$          LOCATION TO STORE THE ANSWER
  3567. '             MIN.LEN       MINIMUM LENGTH OF ANSWER
  3568. '             MAX.LEN       MAX LENGTH OF ANSWER
  3569. '
  3570. '  OUTPUTS -- ANS$          RESPONSE TO THE QUESTION WHICH THE
  3571. '                                      CALLERS SAYS IS CORRECT
  3572. '
  3573. '  PURPOSE -- Subroutine to ask a user a question until the caller
  3574. '             responds that the answer is correct
  3575. '
  3576.       SUB UNTILRIGHT (QUES$,ANS$,MIN.LEN,MAX.LEN) STATIC
  3577. 12880 SUBROUTINE.PARAMETER = 1
  3578.       A$ = QUES$
  3579.       CALL TGET
  3580.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3581.          GOTO 12882
  3582.       IF Q = 0 THEN _
  3583.          GOTO 12880
  3584.       IF LEN(B$(1)) > MAX.LEN THEN _
  3585.          CALL QTPUT1 (STR$(MAX.LEN) + " chars max") : _
  3586.          GOTO 12880_
  3587.       ELSE IF LEN(B$(1)) < MIN.LEN THEN _
  3588.               CALL QTPUT1 (STR$(MIN.LEN) + " chars min") : _
  3589.               GOTO 12880
  3590.       ANS$ = B$(1)
  3591.       A$ = B$(1) + _
  3592.            ", right ([Y],N)"
  3593.       TURBO.KEY = -TURBO.KEY.USER
  3594.       SUBROUTINE.PARAMETER = 1
  3595.       CALL TGET
  3596.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3597.          GOTO 12882
  3598.       IF NO THEN _
  3599.          GOTO 12880
  3600.       CALL ALLCAPS (ANS$)
  3601.       EXIT SUB
  3602. 12882 ANS$ = "GUEST"
  3603.       END SUB
  3604. 13660 ' $SUBTITLE: 'LOGERROR - sub to log errors to CALLERS file'
  3605. ' $PAGE
  3606. '
  3607. '  NAME    -- LOGERROR
  3608. '
  3609. '  INPUTS  --     PARAMETER                    MEANING
  3610. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  3611. '                    ERL           LAST LINE NUMBER ENCOUNTERED
  3612. '                                  PRIOR TO ENCOUNTERNING ERROR
  3613. '
  3614. '  OUTPUTS -- NONE
  3615. '
  3616. '  PURPOSE -- To set up a string to write to the callers log
  3617. '             indicating the date, time, error, and error line
  3618. '
  3619.       SUB LOGERROR STATIC
  3620.       IX = ERR
  3621.       IF ERR < 1 THEN _
  3622.          IX = EC
  3623.       CALL UPDTCALR("+++ Error " + _
  3624.            STR$(IX) + _
  3625.            " line " + _
  3626.            STR$(ERL) + _
  3627.            " at " + _
  3628.            TIME$ + _
  3629.            " on " + _
  3630.            DATE$,2)
  3631.       END SUB
  3632. '
  3633. 20096 ' $SUBTITLE: 'CHECKRATIO - subroutine to print ul/dl ratio'
  3634. ' $PAGE
  3635. '
  3636. '  SUBROUTINE NAME    -- CHECKRATIO
  3637. '
  3638. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  3639. '                          TELL.USER          TELL USER THEIR RATIO
  3640. '                          DOWNLOADS          FILES DOWNLOADED
  3641. '                          DLBYTES!           BYTES DOWNLOADED
  3642. '                          UPLOADS            FILES UPLOADED
  3643. '                          ULBYTES!           BYTES UPLOADED
  3644. '
  3645. '  OUTPUT PARAMETERS  -- OK  - IF IT IS OK FOR THE USER TO DOWNLOAD
  3646. '
  3647. '  SUBROUTINE PURPOSE -- TO PRINT THE USERS UPLOAD TO DOWNLOAD RATIO
  3648. '                        AND TO DETERMINE IF THE USERS HAS VIOLATED
  3649. '                        THEIR UPLOAD TO DOWNLOAD RESTRICTION
  3650. '
  3651. '
  3652.       SUB CHECKRATIO (TELL.USER) STATIC
  3653.       OK = TRUE
  3654. 'IF NOT ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN _
  3655. '   GOTO 20110
  3656. '      IF RATIO.RESTRICTION# = 0 THEN _
  3657. '         GOTO 20110
  3658. '
  3659. ' DETERMINE METHOD OF RATIO CHECKING TO BE PERFORMED
  3660. '
  3661.       IF BYTE.METHOD = 1 OR BYTE.METHOD = 3 THEN _
  3662.          METHOD$ = "Bytes" : _
  3663.          UL.WORK# = ULBYTES! : _
  3664.          DL.WORK# = DLBYTES!
  3665.       IF BYTE.METHOD = 0 OR BYTE.METHOD = 2 THEN _
  3666.          METHOD$ = "Files" : _
  3667.          UL.WORK# = UPLOADS : _
  3668.          DL.WORK# = DOWNLOADS
  3669.       IF BYTE.METHOD = 2 THEN _
  3670.          TODAY# = RATIO.RESTRICTION# - DL.TODAY!
  3671.       IF BYTE.METHOD = 3 THEN _
  3672.          TODAY# = RATIO.RESTRICTION# - BYTES.TODAY! - NUM.DNLD.BYTS!
  3673. '
  3674.       RATIO# = INT(DL.WORK# / 1)
  3675.       RATIO.SUFFIX$ = ":0"
  3676.       IF UL.WORK# > 0 THEN _
  3677.          RATIO# = INT(DL.WORK# / UL.WORK#) : _
  3678.          RATIO.SUFFIX$ = ":1"
  3679.       IF BYTE.METHOD < 2 THEN _
  3680. A$ =  CX$(3)+"Todays Downloaded Files: " + CX$(5)+STR$(DL.TODAY!)+CRLF$ + _
  3681. CX$(2)+  "Number of Bytes today  : " + CX$(4)+STR$(BYTES.TODAY!) +CRLF$ :_
  3682. A$ = A$ + METHOD$ +CX$(1)+ " Downloaded: "+CX$(2) + STR$(DL.WORK#)+CRLF$+ _
  3683.                    CX$(5)+ "Uploaded  : "+CX$(3) + _
  3684.               STR$(UL.WORK#)+CRLF$ : _
  3685.          A$ = A$ + CX$(6)+ "Ratio  : " +CX$(1)+ _
  3686.               STR$(RATIO#) + _
  3687.               RATIO.SUFFIX$ +CX$(7)+CRLF$ : _
  3688.          SUBROUTINE.PARAMETER = 5 : _
  3689.          CALL TPUT
  3690.       IF BYTE.METHOD > 1 THEN _
  3691.          A$ = "Today Downloaded Files: " + STR$(DL.TODAY!)+CRLF$ + _
  3692.               "Bytes:" + STR$(BYTES.TODAY!)+CRLF$ : _
  3693.          SUBROUTINE.PARAMETER = 5 : _
  3694.          CALL TPUT : _
  3695.          CALL SKIPLINE (1)
  3696. IF RATIO.RESTRICTION# = 0 THEN _
  3697.    GOTO 20110
  3698. '
  3699. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3700. '
  3701. 20100 IF NOT (RATIO.RESTRICTION# > 0 AND TELL.USER) THEN _
  3702.          EXIT SUB
  3703.       IF BYTE.METHOD <= 1 THEN _
  3704.          GOTO 20105
  3705.       IF TODAY# <= 0 THEN _
  3706.          A$ = "Sorry, Daily download limit of" + _
  3707.               STR$(RATIO.RESTRICTION#) + " " + _
  3708.               METHOD$ + " Reached" : _
  3709.               OK = FALSE _
  3710.       ELSE A$ = "Download balance remaining:" + _
  3711.                 STR$(RATIO.RESTRICTION#) + _
  3712.                 " " + _
  3713.                 METHOD$ : _
  3714.            OK = TRUE
  3715.       SUBROUTINE.PARAMETER = 5
  3716.       CALL TPUT
  3717.       CALL SKIPLINE(1)
  3718.       EXIT SUB
  3719. '
  3720. 20105 IF RATIO# >= RATIO.RESTRICTION# THEN _
  3721.          OK = FALSE : _
  3722.          A$ = "Sorry, DL/UL ratio of" + _
  3723.               STR$(RATIO.RESTRICTION#) + _
  3724.               ":1 " + _
  3725.               METHOD$ + " exceeded" : _
  3726.          SUBROUTINE.PARAMETER = 5 : _
  3727.          CALL TPUT : _
  3728.          A$ = "Minimum upload of" + _
  3729.               STR$(INT(((DL.WORK# - (UL.WORK# * RATIO.RESTRICTION#)) _
  3730.               / RATIO.RESTRICTION#) + 1)) + _
  3731.      + " " + METHOD$ + " required before You may download" _
  3732.       ELSE _
  3733.         A$ = "Balance remaining before upload required:" + _
  3734.                 STR$(INT((UL.WORK# * RATIO.RESTRICTION#)-DL.WORK#)) + _
  3735.                 " " + METHOD$
  3736.       SUBROUTINE.PARAMETER = 5
  3737.       CALL TPUT
  3738.       CALL SKIPLINE (1)
  3739. 20110  END SUB
  3740. 20140 ' $SUBTITLE: 'GETARC - sub to get what files to verbose list'
  3741. ' $PAGE
  3742. '
  3743. '  NAME    -- GETARC
  3744. '
  3745. '  INPUTS  --     PARAMETER                    MEANING
  3746. '                 Q                     NUMBER OF ENTRIES TYPED
  3747. '                 B$()                  ENTRIES TYPED
  3748. '
  3749. '  OUTPUTS --
  3750. '
  3751. '  PURPOSE --  Process the V)erbose list command.
  3752. '              Takes what user types and tries to list it.
  3753. '
  3754.       SUB GETARC STATIC                                              ' KG081201
  3755. 20141 IF ANS.INDEX >= LAST.INDEX THEN _                              ' KG081201
  3756.          CALL QTPUT1 ("Default extension is "+DEFAULT.EXTENSION$)    ' KG081201
  3757.       A$ = "What compressed file(s)" + PRESS.ENTER.EXPERT$           ' KG081201
  3758.       CALL POPCSTACK                                                 ' KG081201
  3759.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3760.          EXIT SUB                                                    ' KG081201
  3761. 20142 VIOLATION$ = "View ARC"                                        ' KG081201
  3762.       X = ANS.INDEX                                                  ' KG081201
  3763.       FOR ANS.INDEX = X TO LAST.INDEX                                ' KG081201
  3764.          GOSUB 20143
  3765.          IF SUBROUTINE.PARAMETER < 0 THEN _
  3766.             ANS.INDEX = LAST.INDEX + 1                               ' KG081201
  3767.       NEXT
  3768.       IF LAST.INDEX > 1 THEN _
  3769.          EXIT SUB _
  3770.       ELSE GOTO 20141
  3771. 20143 Z$ = B$(ANS.INDEX)                                             ' KG081201
  3772.       CALL ALLCAPS (Z$)
  3773.       CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE)
  3774.       IF EXT$ = "" THEN _
  3775.          EXT$ = DEFAULT.EXTENSION$ : _
  3776.          Z$ = Z$ + "." + DEFAULT.EXTENSION$
  3777.      IF EXT$ = "ARC" _
  3778.      OR EXT$ = "LZH" _
  3779.      OR EXT$ = "PAK" _
  3780.      OR EXT$ = "ZOO" _
  3781.      OR EXT$ = "ZIP" _
  3782.      OR EXT$ = "DWC" THEN _
  3783.              ARK = TRUE ELSE _
  3784.         CALL QTPUT1 ("Only ARC,LZH,PAK,ZOO,ZIP or DWC  files can be viewed") : _
  3785.               RETURN
  3786.       LAST.EXT$ = EXT$
  3787.       FILE.NAME.HOLD$ = Z$
  3788.       FILE.NAME$ = Z$
  3789.       CALL BADFILE (PREFIX$,BAD.FILE.NAME.INDEX)
  3790.       ON BAD.FILE.NAME.INDEX GOTO 20144,20146,20147
  3791. 20144 CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  3792.       ON BAD.FILE.NAME.INDEX GOTO 20145,20146,20147
  3793. 20145 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + (NOT SYSOP),TRUE)
  3794.       IF OK THEN _
  3795.          GOTO 20148
  3796. 20146 Z$ = B$(ANS.INDEX) + _                                         ' KG081201
  3797.            " not found!"
  3798.       CALL UPDTCALR (Z$,2)
  3799.       A$ = Z$ + _
  3800.            " Type correct filename" + PRESS.ENTER.EXPERT$
  3801.       SUBROUTINE.PARAMETER = 1
  3802.       CALL TGET
  3803.       IF SUBROUTINE.PARAMETER = -1 OR Q = 0 THEN _
  3804.          RETURN
  3805.       B$(ANS.INDEX) = B$(1)                                          ' KG081201
  3806.       GOTO 20143
  3807. 20147 CALL SVIOLATION
  3808.       IF DENY.ACCESS THEN _
  3809.          EXIT SUB
  3810.       GOTO 20146
  3811. 20148 CALL QTPUT1 (FILE.NAME.HOLD$ + " has these files")
  3812.       CALL VIEWARC      ' This is in RBBSSUB4.BAS
  3813.       CALL VIEWTXT        'Pete Eibl RBBSSUB1.BAS
  3814.       RETURN
  3815.       END SUB
  3816. 20235 ' $SUBTITLE: 'BADNAME - subroutine to find bad file names'
  3817. ' $PAGE
  3818. '
  3819. '  NAME    -- BADNAME
  3820. '
  3821. '  INPUTS  --     PARAMETER                    MEANING
  3822. '               ACTIVE.MESSAGE.FILE$
  3823. '               ACTIVE.USER.FILE$
  3824. '               CALLERS.FILE$
  3825. '               COMMENTS.FILE$
  3826. '               CONFIG.FILEANAME$
  3827. '               MAIN.MESSAGE.BACKUP$
  3828. '               MAIN.MESSAGE.FILE$
  3829. '               MAXIMUM.VIOLATIONS
  3830. '               PASSWORDS.FILE$
  3831. '               RBBS.BAT$
  3832. '               RCTTY.BAT$
  3833. '               SUBDIR$()
  3834. '               SUBDIR.INDEX
  3835. '               VIOLATION$
  3836. '               VIOLATIONS.THIS.SESSION
  3837. '               Z$                          NAME OF FILE
  3838. '
  3839. '  OUTPUTS  -- BAD.FILE.NAME.INDEX         1 = FILE NAME IS OK
  3840. '                                          2 = SECURITY BREACH TRIED
  3841. '              VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  3842. '              FILENAME$                   NAME OF FILE
  3843. '
  3844. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  3845. '             to either crash the system or to breach RBBS-PC's security
  3846. '
  3847.       SUB BADNAME (BAD.FILE.NAME.INDEX) STATIC
  3848. '
  3849. '
  3850. ' *  TEST FOR SYSTEM FILE ATTEMPT
  3851. '
  3852.       BAD.FILE.NAME.INDEX = 2
  3853.       Z$ = FILE.NAME$
  3854.       CALL BRKFNAME (FILE.NAME$,DR$,PREFIX$,EXTENSION$,FALSE)
  3855.       IF LEN(EXTENSION$) = 3 THEN _
  3856.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",EXTENSION$+",") > 0 THEN _
  3857.             EXIT SUB
  3858.       OK = 0
  3859.       CALL FSECCHK (ACTIVE.MESSAGE.FILE$,PREFIX$,EXTENSION$)
  3860.       CALL FSECCHK (ACTIVE.USER.FILE$,PREFIX$,EXTENSION$)
  3861.       CALL FSECCHK (CALLERS.FILE$,PREFIX$,EXTENSION$)
  3862.       CALL FSECCHK (COMMENTS.FILE$,PREFIX$,EXTENSION$)
  3863.       CALL FSECCHK (FILESEC.FILE$,PREFIX$,EXTENSION$)
  3864.       CALL FSECCHK (MAIN.MESSAGE.BACKUP$,PREFIX$,EXTENSION$)
  3865.       CALL FSECCHK (ORIG.MESSAGE.FILE$,PREFIX$,EXTENSION$)
  3866.       CALL FSECCHK (ORIG.USER.FILE$,PREFIX$,EXTENSION$)
  3867.       CALL FSECCHK (PASSWORDS.FILE$,PREFIX$,EXTENSION$)
  3868.       CALL FSECCHK (RBBS.BAT$,PREFIX$,EXTENSION$)
  3869.       CALL FSECCHK (RCTTY.BAT$,PREFIX$,EXTENSION$)
  3870.       CALL FSECCHK (CONFIG.FILENAME$,PREFIX$,EXTENSION$)
  3871.       IF OK > 0 THEN _
  3872.          EXIT SUB
  3873.       BAD.FILE.NAME.INDEX = 1
  3874.       END SUB
  3875. 20240 ' $SUBTITLE: 'FSECCHK - checks file match except for drive'
  3876. ' $PAGE
  3877. '
  3878. '  NAME    -- FSECCHK
  3879. '
  3880. '  INPUTS  --     PARAMETER                    MEANING
  3881. '               CHECK.THIS$          Name of file to check
  3882. '               PREF2$               Prefix to match against
  3883. '               EXT2$                Extension to match against
  3884. '
  3885. '  OUTPUTS  -- OK                    1 if got match
  3886. '
  3887. '  PURPOSE -- Checks for match on both prefix and extension of a file
  3888. '             name.   Used to catch match on system files not to be
  3889. '             downloaded.
  3890. '
  3891.       SUB FSECCHK (CHECK.THIS$,PREF2$,EXT2$) STATIC
  3892.       IF OK > 0 THEN _
  3893.          EXIT SUB
  3894.       CALL BRKFNAME (CHECK.THIS$,DR$,PREF1$,EXT1$,FALSE)
  3895.       IF PREF1$ = PREF2$ THEN _
  3896.          IF EXT1$ = EXT2$ THEN _
  3897.             OK = 1
  3898.       END SUB
  3899. ' $SUBTITLE: 'ABORTLOGOFF -- RBBS-PC common routine to Abort Autologoff'
  3900. ' $PAGE
  3901. '
  3902. '
  3903.       SUB ABORTLOGOFF STATIC
  3904.       ON SUBROUTINE.PARAMETER GOTO 20300,20326
  3905. '
  3906. ' *
  3907. ' *  COMMON INPUT ROUTINE                                                     *
  3908. ' *
  3909. '
  3910. 20300 CALL CARRIER
  3911.      IF SUBROUTINE.PARAMETER = -1 THEN _
  3912.         EXIT SUB
  3913.      LINES.PRINTED = 0
  3914.      DISPLAY.AS.UNIT = FALSE
  3915.      IN.STACK = FALSE
  3916.      TOA! = FRE("A")
  3917.   IF AUTO.END = 0  THEN _   'pe 04/08/89
  3918.  EXIT SUB
  3919. TEMP! = AUTO.LOGOFF!
  3920. AUTO.LOGOFF! = 25
  3921.       CALL SETABORT (AUTO.LOGOFF!,15)
  3922.      AUTO.WARN! = AUTO.LOGOFF! - 30
  3923.      A = 0
  3924.      B = 0
  3925.      C = 0
  3926.      Q = 1
  3927.      PARM = 0
  3928.      EOL = FALSE
  3929.      YES = FALSE
  3930.      B$ = ""
  3931.      SLEEP.WARN = TRUE
  3932.      NO = FALSE
  3933.      CALL COLORPMT (A$)
  3934.      A$ = A$ + _
  3935.           MID$("! !  ",2*TURBO.KEY+1,2)
  3936.      SUBROUTINE.PARAMETER = 4
  3937.      STOP.SAVE = STOP.INTERRUPTS
  3938.      STOP.INTERRUPTS = TRUE
  3939.      CALL TPUT
  3940.      STOP.INTERRUPTS = STOP.SAVE
  3941.      IF SUBROUTINE.PARAMETER = -1 THEN _
  3942.         EXIT SUB
  3943. 20323 IF PROMPT.BELL THEN _
  3944.         IF LOCAL.USER THEN _
  3945.            BEEP_
  3946.         ELSE CALL PUTCOM(BELL.RINGER$)
  3947. 20325 CALL CARRIER
  3948.      IF SUBROUTINE.PARAMETER = -1 THEN _
  3949.         EXIT SUB
  3950.      IF (NOT FORCE.KEYBOARD) AND LEN(COMMPORT.STACK$) > 0 THEN _
  3951.         Y$ = LEFT$(COMMPORT.STACK$,1) : _
  3952.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  3953.         GOTO 20341
  3954.      IF LOCAL.USER THEN _
  3955.         CALL FINDFUNC: _
  3956.         IF SUBROUTINE.PARAMETER < 0 THEN _
  3957.            EXIT SUB _
  3958.         ELSE GOTO 20326
  3959.      CALL EOFCOMM (CHAR%)
  3960.      IF CHAR% <> -1 THEN _
  3961.         CALL GETCOM(Y$) : _
  3962.         IF SUBROUTINE.PARAMETER = -1 THEN _
  3963.            EXIT SUB _
  3964.         ELSE GOTO 20341
  3965.      CALL FINDTIME (TI!)
  3966.      IF TI! > AUTO.WARN! THEN _
  3967.         IF TI! > AUTO.LOGOFF! THEN _
  3968.            CALL UPDTCALR ("Used AutoLogoff",2) :_
  3969.            SUBROUTINE.PARAMETER = -1 : _
  3970.            EXIT SUB _
  3971.         ELSE IF SLEEP.WARN THEN _
  3972.                 SLEEP.WARN = FALSE : _
  3973.                 A$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _
  3974.                 CALL RINGCALLER
  3975.      CALL FINDFUNC
  3976.      IF SUBROUTINE.PARAMETER < 0 THEN _
  3977.         EXIT SUB
  3978. 20326 CALL QTPUT (".",0)
  3979.       Call DELAYIT (1)
  3980.       Y$ = KEY.PRESSED$
  3981.      IF Y$ <> "" THEN _
  3982.         GOTO 20345
  3983.      SEND.REMOTE = TRUE
  3984.      CALL GOIDLE
  3985.      GOTO 20325
  3986. 20341 SEND.REMOTE = REMOTE.ECHO
  3987.      IF TEST.PARITY THEN _
  3988.         GOTO 20342
  3989.      IF Y$ = CHR$(127) THEN _
  3990.         GOTO 20435
  3991.      GOTO 20345
  3992. 20342 IF Y$ = "" THEN _
  3993.         Y$ = " "
  3994.      IF ASC(Y$) = 141 THEN _
  3995.         OUT LINE.CONTROL.REGISTER,&H1A : _
  3996.         EIGHT.BIT = FALSE : _
  3997.         TEST.PARITY = FALSE : _
  3998.         GR = FALSE
  3999.      Y$ = CHR$(ASC(Y$) AND 127)
  4000. 20345 X$ = Y$                                  'KG101503
  4001.      IF INSTR(LINEEDIT.CHK$,Y$) > 5 _
  4002.         GOTO 20435
  4003.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  4004.         GOTO 20325
  4005.      IF Y$ = "^" THEN _
  4006.         GOTO 20325
  4007.      IF Y$ = CARRIAGE.RETURN$ THEN _
  4008.         GOTO 20347 _
  4009.      ELSE GOSUB 20350
  4010.      IF TURBO.KEY < 1 THEN _
  4011.         GOTO 20346
  4012.      IF Y$ = " " THEN _
  4013.         Y$ = ""
  4014.      IF Y$ <> "/" THEN _
  4015.         B$ = Y$ : _
  4016.         Y$ = CARRIAGE.RETURN$ : _
  4017.         X$ = Y$ : _                       'KG101601
  4018.         GOTO 20347
  4019.      TURBO.KEY = 0
  4020.      GOTO 20325
  4021. 20346 IF LEN(B$) => 254 THEN _
  4022.         A$ = "Input too long!" : _
  4023.         SUBROUTINE.PARAMETER = 5 : _
  4024.         CALL TPUT : _
  4025.         IF SUBROUTINE.PARAMETER = -1  THEN _
  4026.            EXIT SUB _
  4027.         ELSE GOTO 20300
  4028.      B$ = B$ + _
  4029.           Y$
  4030.      GOTO 20325
  4031. 20347 TURBO.KEY = FALSE          ' Carriage Return Handler
  4032.      HIDDEN = FALSE
  4033.      IF NO.ADVANCE THEN _
  4034.         NO.ADVANCE = FALSE : _
  4035.         GOTO 20375 _
  4036.      ELSE CALL LPRNT (CRLF$,0) : _
  4037.           GOSUB 20351 : _
  4038.           GOTO 20370
  4039. 20350 IF LOGON.ACTIVE THEN _                                          ' KG101503
  4040.         IF (Y$ = " " OR Y$ = ";") AND _                              ' KG101503
  4041.            RIGHT$(B$,1) <> " " AND RIGHT$(B$,1) <> ";" THEN _        ' KG101503
  4042.               PARM = PARM + 1 : _                                    ' KG101503
  4043.               LOGON.ACTIVE = (PARM < 3) : _                          ' KG101503
  4044.               HIDDEN = (PARM = 2) : _                                ' KG101503
  4045.               CALL LPRNT(X$,0) : _                                   ' KG101503
  4046.               GOTO 20351                                              ' KG1020303
  4047. 'Was IF HIDDEN AND LOCAL.USER THEN.....
  4048.      IF HIDDEN THEN _                       'PE 11/04/88
  4049.         X$ = "."                                                     ' KG101503
  4050.      CALL LPRNT(X$,0)                                                ' KG101503
  4051. 20351 IF NOT SEND.REMOTE THEN _
  4052.         RETURN
  4053. 20353 CALL PUTCOM (X$)
  4054.      RETURN
  4055. 20370 IF SEND.REMOTE THEN _
  4056.         IF LINE.FEEDS THEN _
  4057.            CALL PUTCOM (LINE.FEED$)
  4058. 20375 IF LEN(B$) > 4000 THEN _
  4059.         A$ = "Try again, " + _
  4060.              FIRST.NAME$ : _
  4061.         SUBROUTINE.PARAMETER = 5 : _
  4062.         CALL TPUT : _
  4063.         IF SUBROUTINE.PARAMETER = -1 THEN _
  4064.            EXIT SUB _
  4065.         ELSE GOTO 20300
  4066.      IF PARSE.OFF THEN _
  4067.         PARSE.OFF = FALSE : _
  4068.         GOTO 20420
  4069.      CALL PARSEIT
  4070.      IF Q = 1 THEN _
  4071.         GOTO 20422                  'KG012602
  4072.      GOTO 20425
  4073. 20420 B$(1) = B$
  4074.      Q = 1
  4075. 20422  IF B$ = "" THEN _              'KG012602
  4076.         Q = 0 : _
  4077.       HIDDEN = FALSE : _       'KG101502
  4078. AUTO.LOGOFF! = TEMP!
  4079.         EXIT SUB
  4080. 20425 IF LEN(B$) < 4 THEN _
  4081.         X$ = LEFT$(B$,3): _
  4082.         CALL ALLCAPS (X$) : _
  4083.         IF X$ = "Y" OR X$ = "YES" THEN _
  4084.            YES = TRUE _
  4085.         ELSE IF X$ = "N" OR X$ = "NO" OR X$ = "A" THEN _
  4086.                 NO = TRUE _
  4087.              ELSE IF X$ = "RE" THEN _
  4088.                      REPLY = TRUE : _
  4089.                      EXIT SUB _
  4090.                   ELSE IF X$ = "K" THEN _
  4091.                           KILL.MESSAGE = TRUE : _
  4092.                        EXIT SUB
  4093.      IF B$(Q) = "NS" OR B$(Q) = "ns" THEN _
  4094.         NON.STOP = TRUE : _
  4095.         B$(Q) = "" : _
  4096.         IF Q > 1 THEN _
  4097.            Q = Q-1
  4098.      FORCE.KEYBOARD = FALSE
  4099.      HIDDEN = FALSE             'KG101503
  4100.      EXIT SUB
  4101. 20435 IF LEN(B$) = 0 THEN _
  4102.         GOTO 20325
  4103.      IF LOGON.ACTIVE THEN _
  4104.         IF INSTR(" ;",RIGHT$(B$,1)) > 0 THEN _
  4105.            PARM = PARM - 1
  4106.      B$ = LEFT$(B$,LEN(B$)-1)
  4107.      CALL LPRNT(LOCAL.BACKSPACE$,0)
  4108.      IF SEND.REMOTE THEN _
  4109.         CALL PUTCOM(BACKSPACE$)
  4110.      GOTO 20325
  4111. AUTO.LOGOFF! = TEMP!
  4112.      END SUB
  4113.